TOS Silver 2000/TOS Silver 2000.iso/programm/MM2_DEV/S/COMP/IMPORT.ICL

Text File | 1994-02-16 | 99.4 KB | 3 lines

⓪ ⓪ (* -----------------------⓪#Modula Compiler  /4.2c/⓪#-----------------------⓪#File mc7: Import-/Export-Behandlung⓪#⓪$26.3.85  GDOS Version⓪$30.7.85  Export/Import von Stringkonstanten gerader Laenge⓪-Import von Record-Feldern aus DefMod ins zugehoerige⓪.ImpMod nicht mehr global⓪-erster Versuch zum EnumExport-Problem⓪%7.8.85  Exportlisten optional (neuer Standard: alles qual. exportieren)⓪$19.8.85  Global-Level in DefModulen bleibt 0⓪$28.8.85  CompileTime-Absturz bei fehlender Export-Liste ausgeschlossen⓪#11.12.85  Reload beim Holen des Namens 'RUNTIME' verhindert⓪#12.12.85  in PlaTree Platzkalkulation geaendert⓪#14.12.85  Aenderung vom 12. erstmal wieder rueckgaengig gemacht⓪#22.02.86  Neuordnung der Texte⓪#23.02.86  Wert von MinInt geaendert (muss Long eingetragen sein);⓪-Relay (Kennung 0) in die ItemListe eingetragen, in PlaTree⓪-Einsetzen der Beschreibung bei Relays verhindert.⓪#14.04.86  Import von Opaques auf Umwegen in die eigene Implementation⓪-verhindert nicht mehr die Nach-Deklaration⓪#09.09.86  FROM modulname IMPORT holt Modulname mit OldId statt GetId⓪#15.10.86  Pseudo-Modul und System-Modul definiert;⓪-Importe aus System abgefragt und auf internes Modul gelenkt;⓪-nur noch fuer 9 Standardtypen werden xxxPtr eingetragen.⓪#16.10.86  Resultat Expand (Cardinal) von LongCard nach LongBoth geaendert;⓪-ImPseud importiert bei $G+ auch SystemModul komplett;⓪-Std-Funktionen MIN und MAX (Pseudo);⓪-Fehlerbehandlung bei Ueberlauf von Neubildlisten (rImpOv) jetzt⓪-in den aufrufenden Prozeduren, mit richtiger TextPos-Anzeige.⓪#21.10.86  Char-Definition mit 1 oder 2 Bytes fuer Atari/Gepard Version⓪#23.10.86  PlaTree erkennt Relay-Objekte als importiert, wenn ihr⓪-Originaleintrag importiert ist⓪#24.10.86  System-Modul auf Prozesse vorbereitet (aber noch eingeklammert);⓪-Type Process in der Item-Liste aufgenommen.⓪#25.10.86  Prozess-IDs in System freigegeben⓪#26.10.86  Korrektur der Item.Nr fuer System19;⓪-Aenderung vom 23. funktioniert jetzt (Abfrage des Import-Flags⓪-durch BTST #13)⓪#28.10.86  Korrektur der Parameter von IOTRANSFER und NEWPROCESS in System⓪$1.11.86  Aenderung vom 23.10. wieder zurueck, damit Export von⓪.Type = StandardType moeglich wird. Bei Entstehen eines Relays⓪.durch nachtraegliches Bekanntwerden des Namens im Import⓪.'erbt' der Relay die Flags des bestehenden Eintrags!⓪.(OwnItm und ImpItm).⓪$2.11.86  fuer Atari-Version 'LONG' in 'LONGWORD', 'EXPAND' in 'LONG'⓪.umgetauft.⓪$8.11.86  Typ PROCESS in System entfaellt, stattdessen Verweise auf Address⓪#24.03.87  Atari-Version: auch leere Importlisten (nur Typ/Const in Impl.)⓪.bleiben drin, damit ImplMod fuer Versionskontrolle geladen⓪.wird. (CloseImp)⓪-Atari: ausfuehrliche Key-Berechnung (CopyInf)⓪#30.03.87  Atari, CloseImp: Pseudomodul-imports nicht rausschreiben⓪#07.04.87  TT, DefMod: Key=0-Verwertung anders, neue Keyber. auch f. Gepard⓪#14.04.87  Key-Berechnung relativ zum globalen User-Id Baum⓪#16.06.87  Platzvergabe für Importphase und Baumplätten umgestellt;⓪.der freie Platz wird in festen Verhältnissen aufgeteilt⓪#19.06.87  neue Platzverteilung in InitImp⓪#26.06.87  SIZE wird Standardfunktion (statt aus SYSTEM) bei Atari⓪#14.07.87  TT, Atari,CloseImp: Auch Systemmodul-imports nicht rausschreiben⓪#22.07.87  TT, Atari: Neue System-Proc LISTEN⓪#25.10.87  Atari: neues Format der Importliste von DefMods:⓪.keine Namen der importierten Module mehr drin.⓪.Es wird immer das wirkliche Ursprungsmodul aufgeführt, auch⓪.bei importierten IDs, die (als TYPE a = B) reexportiert werden.⓪#26.10.87  Atari: BITSET = SET OF [0..15].⓪#27.10.87  DefMod: ^Modulnamen auf relAdr 22 und Namensfeld dahinter⓪.wird in DefnModule eingetragen⓪#05.11.87  OwnDef verkraftet leere Definitionsmodule⓪#16.11.87  Atari: IOCALL in System definiert⓪#17.11.87  Atari: LISTEN-Eintrag in System korrigiert -> IOCALL geht jetzt.⓪-beim Runtime-Import werden die Seriennummern geprüft und⓪-ggf. die Items-Tabelle vermurkst⓪#29.05.88  ITEMS-Tabelle: neue Beschreibung für 'Procedure', beim⓪/Importieren wird Platz für die Längen/Anf.adressen-Felder⓪/angehängt;⓪-CopInf, ImpItm verarbeiten die zusätzliche Kodierung in ITEMS⓪#28.06.88  ImpQual markiert importierte IDs richtig (Änderung vom 2.4.)⓪#29.06.88  OwnItm markiert nur noch Prozeduren, und die in Bit 12 (Extern)⓪/statt in Bit 14 (Export). BIT 14 IST FÜR LOKALEN IMPORT/EXPORT⓪/RESERVIERT!! (außer in Definitionsmodulen beim Baumplätten).⓪$2.07.88  System-Modul: Exporte als QUALIFIED markiert⓪#10.12.89  Nachtrag vom 31.03.89:⓪0DefMod: verrechnet kompletten Modulnamen im Key,⓪0wenn K+ Option~ gesetzt ist.⓪#13.12.89  Nachtrag vom 31.08.89⓪0DefMod: verrechnet nun immer kompletten Modulnamen⓪0im Key (V3.7b)⓪-Pseudo: neue Standardbezeichner⓪0VAL     Std.function   9,⓪0LENGTH  Std.function  10,⓪0SIZE    Std.function  11,⓪0LONGREAL;⓪-System: neuer Bezeichner CAST  Std.function 104,⓪0VAL und SIZE entfallen⓪#14.12.89  TT LOC in SYSTEM nachgetragen, hat z.Zt. selbe Nr., wie BYTE (38)⓪0REAL hat nur noch 4 Byte,⓪0In ITEMS-Tab LONGARRAY und LONGREAL nachgetragen⓪#18.12.89  TT neue SYSTEM-Funktionen:⓪2CADR  105, DEREF 106⓪0neue Pseudo-Funktionen:⓪2INT  12, CAP  13, CHR  14, FLOAT  15, LFLOAT 16, TRUNC  17⓪0Pseudo: Einträge 11 (PROC) und 58 (LONGREAL) vertauscht;⓪:auch 11er-Import in System-Modul angepaßt⓪8ImPseud kopiert nun auch LongReal-Pointer⓪8Paramter SHORT (LONGREAL): REAL und⓪ALONG (REAL): LONGREAL nachgetragen⓪#31.12.89  TT Pseudo: ZZ-Type neu (Kennung 4);⓪8LONG (INTEGER/CARDINAL) liefern nun LONGINT/LONGCARD⓪#09.01.90  TT Pseudo: LONG/SHORT (SBothTyp/BothTyp) hinzugefügt⓪#10.01.90  TT Pseudo: Proc wieder an alten Platz gesetzt (11), dazu LongReal⓪8und einen ABS-Parm verschoben.⓪#12.01.90  TT System: SHORT (INTEGER/CARDINAL) ergibt BYTE⓪#02.02.90  TT ImpItm16: Bei Kennung 7 (n Byte im Baum reservieren) wird der⓪0Bereich auch gleich gelöscht. Außerdem in selber Routine einige⓪0ADDQ.W #x,D6 durch ADDQ.L ersetzt⓪0ITEMS: Für Vars 2 Byte mehr reserviert (nur lokal)⓪#19.02.90  TT Pseudo: ZZ mit gesetztem Bit 15, damit es auch in Neubild-Liste⓪2kommt.⓪0Neubild: Liste wird vollst. gelöscht (bisher nur Item-Nr)⓪#27.02.90  TT Pseudo/System: BITSET nun in SYSTEM⓪#21.04.90  TT CopInf: D3 (Key) wird bei Unterbaum nicht mehr zerstört,⓪2statt Baum-Offset wird nun die Item-Nr im Key verrechnet,⓪2durch Einbeziehung der Item-Flags wird auch zw. REF/VAR/value,⓪2zw. D0-/(A3)-Rückgabe und Proc-Parm-Modus im Key unterschieden⓪#09.05.90  TT CALLSYS, CALLEXT, LOAD, STORE, CODE neu in SYSTEM, SHORTCARD⓪2SHORTINT neu in Pseudo⓪#30.06.90  TT BITSET nun mit Kennung 45 statt 5: immer neue Ordnung (unabh.⓪2von $U-Option)⓪#30.07.90  TT ITEMS: Record-Felder um einen Eintrag zum Verketten der⓪1Reihenfolge erweitert; neue Kennungen 16, 46 für Rec-Varianten.⓪#18.08.90  TT Record-Eintrag (#13) geändert: vor dem Baum und seinem Ptr⓪2steht nun der Ptr auf das 1. Element. Dadurch verschiebt⓪2sich der Ptr auf den lok. Baum um 4 Byte (von -10 auf -14).⓪#12.09.90  TT SetDef0,ImpItm16: Importierte Real-Konstanten werden ins⓪2Zielformat konvertiert, allerdings noch nicht bei ShortReals!⓪#23.09.90  TT PlaTre, CopInf: Tragen Enum-Elemente nun explizit nach.⓪0PlaTre2 trägt nur exportierte Items und die von Unterbäumen ein.⓪0NumImp entfernt unbenutze Items aus ImportListe, DefMod⓪0schiebt daraufhin geplätteten Baum runter; Rec-Variante von⓪0Kennung 16 auf 47 verlegt; Die eigenen ItemNrn von Importlisten⓪0in Def-Modulen sind auch nur noch 2 Byte statt 4 Byte groß.⓪0Werden schon bekannte IDs nochmals importiert (m/o FROM),⓪0dann werden bestehende Relays übersprungen, weil sonst doppelt⓪0verkettete Relays entstehen (ImpItm20, OwnItm).⓪0ITEMS: Proc-Type (44): Def. geändert.⓪#23.10.90  TT ImpItm16/20,ImpAll,ImpRest,FromImp,ScanItm,ListImp,ItemAdr:⓪0Kennung 7 über anonFlag eingeführt, um Gemischtimporte von⓪0Enum-Typen und ihren Elementen korrekt zu erkennen. Doku⓪0siehe GlobImp⓪#02.03.91  TT IPIMP: Importierte externe Vars werden nicht mehr in die⓪0Relozierliste aufgenommen, so daß nun die Adr erhalten bleibt.⓪#27.12.93  TT ImPseud: StrPtr ist nun identisch mit SSTyp; ITEMS: Kenn.50 neu.⓪#15.02.94  TT SETILST: Übernimmt nun wieder Modulnamen in Importliste, aber⓪0nur während compiletime, nicht ins erzeugte Defmodul.⓪0ImpXRef/IPIMP: relozierbare Items, die aus einem anderen als⓪0dem importierten Defmod stammen, werden nachträglich in die⓪0Importliste des erzeugten Impmods aufgenommen.⓪#-----------------------------------------------------⓪ *)⓪ ⓪ (*⓪!*⓪!*   Langfristige Registerbelegung:⓪!*⓪!*   A1 = Wurzel des ID-Baums⓪!*   A2 = ^Text⓪!*   A4 = ^erzeugten Code⓪!*   A5 = ^Neubildlisten (bei Import)⓪!*   A6 = ^Display Stack⓪!*⓪!*   TOI = Top of ID-Stack⓪!*⓪!* Eine Neubildliste ist ein Feld von Longs. Der Index ist die beim Plätten⓪!* vergebene ItemNr, der Long-Wert der dazu gehörige Pointer auf die⓪!* Beschreibung im Baum.⓪!*)⓪!⓪ CONST ModNameLen = 25;  (* Anzahl sign. Zeichen in ModNames *)⓪ ⓪ CONST    PseudoKey = $12345679;⓪)SystemKey = $87654321;⓪ ⓪ VAR       ILSTART,⓪,ILEND,⓪,AllExp,⓪(CurrentDef,⓪(CurrentKey: ADDRESS;⓪$explicitImport,             (* TRUE: FROM ... IMPORT in Bearbeitung *)⓪%mustChgFormat: BOOLEAN;⓪)defFormat,⓪*anonFlag: Cardinal;⓪ ⓪2(* anonFlag = 2: gerade kopiertes Item ist anonym, auch⓪7Verweise auf Enumelemente sind anonym einzutragen.⓪5anonFlag = 7: kopiertes Item hat Namen, auch fuer⓪7Enumelemente Namenseintrag fordern *)⓪ ⓪ FORWARD ImpItm;⓪ FORWARD ImpItm1;⓪ FORWARD ImpItm16;⓪ FORWARD ImpItm20;⓪ FORWARD ImpItm30;⓪ FORWARD ListImp;⓪ FORWARD SetDef0;⓪ FORWARD CopInf;⓪ FORWARD PlaTre;⓪ FORWARD PlaTre2;⓪ FORWARD MarkExp;⓪ FORWARD NumImp;⓪ FORWARD Define;⓪ FORWARD GlobExp;⓪ FORWARD CloseImp;⓪ FORWARD OwnDef;⓪ FORWARD ImpQual;⓪ FORWARD Runtime;⓪ FORWARD ImpAll;⓪ FORWARD ImpPer;⓪ FORWARD ImpGlob;⓪ FORWARD FromImp;⓪ FORWARD ImpRest;⓪ FORWARD MyPullId;⓪ FORWARD ImpXRef;⓪ ⓪ (*⓪!*   ----------------------------------⓪!*   Definition Module uebersetzen⓪!*   ----------------------------------⓪!*⓪!*      A4 = ^erzeugten Code⓪!*⓪!*)⓪!⓪ PROCEDURE DefMod;⓪ BEGIN ASSEMBLER⓪)MOVE.B  #DLAYOUT,(A4)+ ;Modul-Format⓪)MOVE.B  #3,(A4)+      ;Kennung: DefMod⓪)JSR     PUT2          ; 2:qual.Flag⓪)JSR     PUT3          ; 4:Key⓪)JSR     PUT3          ; 8:^gepl.Baum⓪)JSR     PUT2          ;12:Anzahl exp. Items⓪)JSR     PUT3          ;14:^Imports⓪)JSR     PUT3          ;18:Platz der definierten Variablen⓪)MOVE.L  A4,-(A7)⓪)JSR     PUT3          ;22:^Modulname⓪)JSR     PUT2          ;26:Ende d. Headers (Word!) - erst ab DLayout 6!⓪)JSR     PUT2          ;28:^Sourcename (Word!)⓪)JSR     PUT3          ;30:Liste der implizit zu importierenden Module⓪)⓪); Modulnamen/Ende d. Headers eintragen⓪)MOVE.L  A4,D0⓪)SUB.L   Header,D0⓪)MOVE.L  (A7)+,A0⓪)MOVE.L  D0,(A0)+      ;^Modulname⓪)MOVE.W  D0,(A0)+      ;^Headerende⓪)⓪)JSR     LookId        ;A0 := ^ Top of ID-Stack⓪!en3     MOVE.B  (A0)+,(A4)+⓪)BNE     en3           ;kopieren bis Endmarke 0.B⓪)JSR     put0          ;sync⓪)⓪)JSR     GetSbl⓪)JSR     GlobImp       ;Import-Statements⓪)JSR     GlobExp       ;Export-Satements⓪)JSR     Define        ;Deklarationen⓪)CMPI.W  #35,D3        ;END?⓪)BEQ     OK1⓪)MOVE    #rDecl,D5⓪)JMP     SyntaxErr⓪ !OK1     JSR     FinLblAndFwrd ;Sind alle Fwrd-Refs aufgelöst?⓪)JSR     MarkExp       ;Exports im Baum markieren⓪)JSR     PlaTre        ;gepl.Baum erstellen⓪)JSR     NumImp        ;Imports mit eigener ItemNr versehen⓪)CLR.L   (A4)+         ;impliz. Importliste abschließen⓪)⓪); Nun geplätteten Baum und implizite Importliste⓪); zurückschieben (Offset ist in D0)⓪)MOVE.L  Header,A3       ;Code-Anfang⓪)MOVE.L  8(A3),D1      ;alter ^geplaetteten Baum⓪)BEQ     nomove        ;keine Exportliste (dann auch keine impl. ImpLst)⓪)MOVE.L  D1,A0⓪)SUB.L   D0,8(A3)⓪)SUB.L   D0,30(A3)⓪)ADDA.L  A3,A0⓪)MOVE.L  A0,A5⓪)SUBA.L  D0,A0         ;neue Adr.⓪);Anfang des gepl.Baums in A5, Ende in A4, Ziel in A0⓪)SUBA.L  D0,A4         ;A4 ist nun Ziel-Ende⓪ movtree  MOVE.L  (A5)+,(A0)+⓪)CMPA.L  A4,A0⓪)BCS     movtree⓪ nomove⓪)MOVE.L  KEY,D0⓪ ExtKey   MOVE.L  IDStkBPtr,A0  ;neue Key-Berechnung: alle Namens-Bytes rein⓪)ADDQ.L  #1,A0⓪ ekloop   MOVE.B  (A0)+,D1⓪)BEQ     ekend⓪)EOR.B   D1,D0⓪)ROL.L   #1,D0⓪)BRA     ekloop⓪ ekend    TST.L   D0⓪)BNE     ok3⓪)MOVEQ   #1,D0         ;0-Key verhindern⓪ ok3      MOVE.L  Header,A0⓪)MOVE.L  D0,4(A0)⓪'END⓪ END DefMod;⓪ ⓪ ⓪ (* §§§⓪ *   ----------------------------------⓪ *   Imports in DefModule mit deren eigener ItemNr versehen⓪ *   ----------------------------------⓪ *⓪ * Bisher enthalten die Importlisten noch Ptr auf die IDs. Nun werden⓪ * daraus Item-Nrn gemacht. Nicht benutzte Items, also solche, die nicht⓪ * in der Neubildliste auftreten, werden entfernt. Der Wert, um den sich⓪ * die Liste verkürzt hat, wird in D0 geliefert.⓪ *⓪ * 15.02.94:⓪ * Wg. Alias-Prozeduren müssen ggf. die Modulnamen für implizite Importe⓪ * eingetragen werden. Dazu wird hier einfach der Name jedes Moduls erstmal⓪ * am Code (A4, hinter lin. Baum) angehängt und nur dann wieder entfernt,⓪ * wenn keine Prozedur in der Importliste übrigbleibt.⓪ *⓪ *      (D0,D1,A0,A5)⓪ *⓪ *      A3 = ^NeubildListe des importierenden Moduls⓪ *      D5 = höchste eigene ItemNr + 1⓪ *⓪ *      D0: Wert, um den die Liste kürzer geworden ist.⓪ *)⓪ PROCEDURE NumImp;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.L  A4,-(A7)⓪)MOVE.L  Header,A0⓪)MOVE.L  A4,D0⓪)SUB.L   A0,D0⓪)MOVE.L  D0,30(A0)     ;^implizite Importliste⓪)ADDA.L  14(A0),A0     ;^ImportListe⓪)MOVE.L  A0,A5         ;^neue Importliste⓪)⓪ !NumImp4 MOVE.L  (A7),A4⓪)MOVE.L  (A0)+,D0⓪)MOVE.L  D0,(A5)+      ;Ende der ImportListe?⓪)BEQ     NumImp2       ; ja⓪)⓪)MOVE.W  (A0)+,(A5)+   ;Import in DefMod: Itemanzahl kopieren⓪)⓪)MOVE.L  D0,(A4)+      ;Key kopieren⓪)⓪)TST.W   (A0)+         ;ist Modulname vorhanden?⓪)BNE     NumImp5⓪)⓪)MOVE.B  #'?',(A4)+    ;zum leichteren Debuggen dummy-Namen einfügen⓪)MOVE.B  #$FF,(A4)+⓪)BRA     NumImp1⓪)⓪ !NumImp5 MOVE.W  (A0)+,D0      ;Modulname f. implizite Importliste kopieren⓪)MOVE.W  D0,(A4)+⓪)CMP.B   #$FE,D0⓪)BCS     NumImp5⓪ ⓪ !NumImp1 MOVE.W  (A0)+,(A5)+   ;Ende des Imports aus diesem Modul?⓪)BEQ     NumImp4       ; ja⓪)MOVE.L  (A0)+,D0      ;bisheriger Item-Ptr⓪)MOVE.L  A3,-(A7)      ;^Anfang der Neubildliste retten⓪)CLR.W   D1⓪ !NumImp3 ADDQ.W  #1,D1         ;Import in NeubildListe suchen⓪)CMP.L   (A3)+,D0⓪)BEQ     NumImp6       ;gefunden: D1 ist eigene ItemNr⓪)CMP.W   D5,D1         ;alle Items durch?⓪)BCS     NumImp3       ; nein, weiter⓪)⓪)SUBQ.L  #2,A5         ; ja, nicht gefunden: entfernen⓪)MOVE.L  (A7)+,A3⓪)BRA     NumImp1⓪)⓪ !NumImp6 MOVE.W  D1,(A5)+      ;eigene ItemNr eintragen⓪)MOVE.L  (A7)+,A3⓪)MOVE.W  -2(A1,D0.L),D0 ;Item-Kennung⓪)ANDI    #$80FF,D0⓪)CMPI    #$8006,D0⓪)BNE     NumImp1⓪)MOVE.L  A4,(A7)        ;Dieses Modul bleibt in Impliziter Modulliste⓪)BRA     NumImp1⓪ ⓪ NumImp2  MOVE.L  A0,D0⓪)SUB.L   A5,D0⓪)ADDQ.L  #4,A7⓪ END⓪ END NumImp;⓪ ⓪ (*⓪!*   ----------------------------------⓪!*   Export-Statement:⓪!*      qual/perv. Flags setzen, IDs auf ID-Stack holen⓪!*   ----------------------------------⓪!*⓪!*      D3 = Symbol (EXPORT falls vorhanden)⓪!*⓪!*      (A0)⓪!*⓪!*      D3 := folgendes Symbol⓪!*      ID-Stack := exp. IDs⓪!*      xpcount := Anzahl der exp. IDs⓪!*      AllExp := "keine ExportListe - alles qualified exportieren"⓪!*)⓪!⓪ PROCEDURE GlobExp;⓪ BEGIN ASSEMBLER⓪*CLR.W   XPCNT⓪*CMPI.W  #1,D3⓪*BNE     GlobExp3      ;keine Exportliste⓪*CLR.W   AllExp        ;also nur gelistete IDs exportieren⓪*JSR     GetSbl⓪*MOVE.L  Header,A0⓪*CMPI.W  #64,D3        ;QUALIFIED?⓪*BNE     GlobExp4⓪*MOVE.W  #1,2(A0)      ;qual.Flag⓪*BRA     GlobExp2⓪ !GlobExp4 CMPI.W  #76,D3        ;PERVASIVE?⓪*BNE     GlobExp1⓪*MOVE.W  #2,2(A0)⓪ !GlobExp2 JSR     GetSbl⓪ !GlobExp1 TST.W   D3⓪*JSR     OLDID0⓪*ADDQ.W  #1,XPCNT⓪*JSR     GetSbl⓪*CMPI.W  #10,D3        ;,⓪*BEQ     GlobExp2⓪*CMPI.W  #11,D3        ;;⓪*BEQ     OK1⓪*MOVE    #rSemXp,D5⓪*JMP     SyntaxErr⓪ !OK1      JMP     GetSbl⓪ !GlobExp3 MOVE.W  #1,AllExp     ;wir wollen alles exportieren⓪*MOVE.L  Header,A0⓪*MOVE.W  #1,2(A0)      ; und zwar qualified⓪'END⓪ END GlobExp;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Deklarationen des DefModuls uebersetzen:⓪ *      IDs in ID-Baum eintragen;⓪ *      Platz der deklarierten Var in Modul eintragen⓪ *   ----------------------------------⓪ *⓪ *      D3 = 1. Symbol⓪ *⓪ *      (A0)⓪ *⓪ *      D3 := folgendes Symbol (muss END sein)⓪ *      VarSpc := Platzbedarf der deklarierten Variablen⓪ *)⓪ PROCEDURE Define;⓪ BEGIN⓪ ASSEMBLER⓪)CLR.L   VARSPC⓪ !Define5 CMPI.W  #57,D3        ;CONST⓪)BNE     Define1⓪)JSR     CONSDEC⓪)BRA     Define5⓪ Define1  CMPI.W  #58,D3        ;TYPE⓪)BNE     Define2⓪)JSR     TYPEDEC⓪)BRA     Define5⓪ Define2  CMPI.W  #56,D3        ;VAR⓪)BNE     Define3⓪)JSR     VARDEC⓪)BRA     Define5⓪ Define3  CMPI.W  #59,D3        ;PROCEDURE⓪)BNE     Define4⓪)MOVE.L  VARSPC,-(A7)⓪)JSR     GetSbl⓪)JSR     PRHEAD⓪)JSR     CLRTRE        ;lokale Var etc loeschen⓪)JSR     PULLID⓪)SUBQ.W  #1,GLOBAL     ;hier kommt nix lokales⓪)MOVE.L  (A7)+,VARSPC  ;Var-Adr der globalen Ebene⓪)JSR     GetSbl⓪)BRA     Define5⓪ !Define4 MOVE.L  Header,A0⓪)MOVE.L  VARSPC,18(A0)⓪ END⓪ END Define;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Struktur der Baumeintragungen⓪ *   ----------------------------------⓪ *⓪ *   Kodierung:   ItemKennung {Komponente} 0⓪ *   Komponenten: 1=Ptr (Item-Nr) 2=Const.L 3=Const.W 4=New_Scope 5=^ID (EnumTyp)⓪ *                6=Laengenangabe 7,n=Insert <n> Bytes, 8=^ID (EnumElem)⓪ *)⓪ PROCEDURE ITEMS;⓪ BEGIN⓪ ASSEMBLER⓪); ACHTUNG:⓪); Bei den Items 6, 17 und 50 _muß_ das 1. Feld (Adr.L) unbedingt⓪); mit ins DEF-Modul hinein, wenn es dort auch nur unnötig Platz⓪); belegt. Also dort eine '2' statt '7,4' eintragen! Denn in IPIMP⓪); wird in dieses Feld direkt ein Wert geschrieben, ohne daß dann⓪); die Bytes reserviert wären, wenn ein Insert dort angegeben wäre.⓪)DC.B    0,1,0         ;Relay⓪)DC.B    1,2,0         ;LINT⓪)DC.B    2,2,0         ;LONGREAL⓪)DC.B    3,2,0         ;CHAR⓪)DC.B    4,2,0         ;ZZ⓪)DC.B    5,2,1,0       ;SET⓪)DC.B    6,2,1,1,2,7,8,0   ;PROC⓪)DC.B    7,1,1,3,0     ;PARAM⓪)DC.B    8,2,0         ;REDECLARABLE OPAQUE⓪)DC.B    9,2,2,5,0     ;ENUM⓪)DC.B    10,3,1,8,0    ;ENUM.ELEMENT⓪)DC.B    11,2,2,2,1,0  ;SUBR⓪)DC.B    12,2,1,1,0    ;ARRAY⓪)DC.B    13,2,1,4,0    ;RECORD⓪)DC.B    14,2,1,1,0    ;REC.FELD⓪)DC.B    15,4,0        ;Lok.Module⓪)DC.B    16,4,0        ;Qualifier bei importierten Modulen⓪)DC.B    17,2,1,2,7,2,0;VAR⓪)DC.B    18,1,6,0      ;CONST alt, ohne String-Literals (s. Nr.31)⓪)DC.B    19,2,1,1,0    ;PROC.TYPE⓪)DC.B    20,2,1,0      ;PTR⓪)DC.B    21,2,0        ;WORD⓪)DC.B    22,2,0        ;LCARD⓪)DC.B    23,2,1,0      ;ADDRESS⓪)DC.B    24,2,0        ;BOOLEAN⓪)DC.B    25,2,0        ;OPAQUE⓪)DC.B    26,2,0        ;LONG⓪)DC.B    27,2,2,0      ;STRING⓪)DC.B    28,2,2,2,2,0  ;TABLE (nicht exportierbar)⓪)DC.B    29,2,2,2,3,0  ;Asm-Label (nicht exportierbar)⓪)DC.B    30,2,0        ;LBOTH⓪?;31: String-Literal (alt)⓪)DC.B    32,1,0        ;OPEN ARRAY⓪)DC.B    33,2,0        ;SINT⓪)DC.B    34,2,0        ;SCARD⓪)DC.B    35,2,0        ;SBOTH⓪)DC.B    36,3,1,0      ;StandardProc⓪)DC.B    37,1,1,1,0    ;StandardProcParams⓪)DC.B    38,2,0        ;BYTE⓪)DC.B    39,2,0        ;Signed BYTE⓪)DC.B    40,2,0        ;REAL⓪)DC.B    41,2,0        ;BITNUM⓪)DC.B    42,1,0        ;OPEN LONGARRAY⓪)DC.B    43,2,0        ;untyped/structured Constant⓪)DC.B    44,2,1,0      ;PROC.TYPE bei Parametern (8 Byte Länge)⓪)DC.B    45,2,1,0      ;SET (neue Ordnung)⓪)DC.B    46,1,2,2,1,0  ;Record-Tag⓪)DC.B    47,2,1,1,1,1,0;Rec-Variante⓪)DC.B    48,0          ;Forward-Typ⓪)DC.B    50,2,1,7,4,6,0 ;CONST neu (nun incl. String-Literals)⓪)DC.B    63,0          ;Dummy-Eintrag⓪)DC.B    0⓪)SYNC⓪ END⓪ END ITEMS;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Exportierte ID's im Baum markieren⓪ *   (nur benutzt, falls explizite Exportliste vorhanden ist!)⓪ *   ----------------------------------⓪ *⓪ *      (D0-D3)⓪ *⓪ *      TOI = exportierte IDs⓪ *      xpcount = Anzahl der IDs auf Stack⓪ *)⓪ PROCEDURE MarkExp;⓪ BEGIN⓪ ASSEMBLER⓪ !ML      SUBQ.W  #1,XPCNT⓪)BMI     MarkExp1       ;keine explizite Exportliste⓪)JSR     PULLID⓪)MOVE.L  A0,-(A7)⓪)JSR     SEARCHID       ;liefert in D1 Ptr auf ggf. Relay-Eintrag⓪)MOVE.L  (A7)+,A0⓪)TST.W   D3⓪)BNE     OK11⓪)⓪)MOVE    #rExpUn,D5⓪ error    JSR     LoadBadID⓪)JMP     SyntaxErr⓪ ⓪ !OK11    BMI     OK12⓪ ⓪ !ER71    MOVE    #rBdExp,D5⓪)BRA     error⓪ ⓪ !OK12    BTST    #13,D3         ;Import?⓪)BEQ     OK⓪ ⓪)MOVE    #rReExp,D5     ;ACHTUNG: auch "Type ID = importedType" wird⓪)BRA     error          ; hier verboten, da das ImportFlag im imp.⓪@; Eintrag gesehen wird!⓪ ⓪ !OK      BSET    #6,-2(A1,D1.L) ;als Exp markieren (ggf. in Relay-Eintrag)⓪)BNE     dblExp         ;wurde schon exportiert⓪)(* Enum-Elems werden sowieso in CopInf berücksichtigt⓪+CMPI.B  #9,-1(A1,D2.L) ;Enum?⓪+BNE     ML⓪+MOVE.L  -14(A1,D2.L),D2⓪"MarkExp2 BSET    #6,-2(A1,D2.L) ;Element exportieren⓪+BNE     dblExp         ;wurde schon exportiert⓪+MOVE.L  -12(A1,D2.L),D2⓪+BNE     MarkExp2⓪)*)⓪)BRA     ML⓪ dblExp   MOVE    #rDblEx,D5     ;doppelter Export⓪)BRA     error⓪ MarkExp1⓪ END⓪ END MarkExp;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   ItemNummer vergeben beim BaumPlaetten⓪ *   ----------------------------------⓪ *⓪ *      D1 = ^Objekt im ID-Baum, das numeriert werden soll⓪ *      D5 = hoechste bisher vergebene Nr⓪ *      A3 = ^Array [ItemNr] of ID-Baum-Adr⓪ *      A5 = ^Array [ItemNr] of Eintrag-Status⓪ *⓪ *      D0 := vergebene ItemNr⓪ *⓪ *      Schluessel fuer Status-Array:⓪ *        0   fertig im PlaTree eingetragen⓪ *        2   Vorwaertsref, muss anonym eingetragen werden⓪ *        3   Vorwaertsref, muss nicht-anonym eingetragen werden⓪ *)⓪ PROCEDURE ItemNr;⓪ BEGIN⓪ ASSEMBLER⓪)TST.L   D1⓪)BEQ     ItemNr3      ;nil-Ptr: Sonderfall⓪)MOVE.W  D5,D0⓪)BEQ     ItemNr1      ;noch keine Nr vergeben⓪)SUBQ.W  #1,D0⓪)MOVE.L  A3,-(A7)⓪ !ItemNr2 CMP.L   (A3)+,D1     ;Item in bereits numerierten suchen⓪)DBEQ    D0,ItemNr2⓪)MOVE.L  (A7)+,A3⓪)BNE     ItemNr1      ;nicht gefunden: neue vergeben⓪)NEG.W   D0           ;gefunden⓪)ADD.W   D5,D0⓪)RTS⓪ !ItemNr1 ; MOVE.B  #1,0(A5,D5.W) ;als 'nicht im PlaTree' markieren⓪)MOVE.B  #2,0(A5,D5.W) ;!!!⓪)MOVE.W  D5,D0⓪)LSL.W   #2,D0⓪)MOVE.L  D1,0(A3,D0.W) ;in Adr-Liste eintragen⓪)ADDQ.W  #1,D5⓪)MOVE.W  D5,D0⓪)RTS⓪ !ItemNr3 CLR.W   D0⓪ END⓪ END ItemNr;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Geplaetteten Baum erstellen⓪ *   ----------------------------------⓪ *⓪ *      A3: Array [ItemNr] of ID-Baum-Adressen  (EvalStkPtr wird gerettet)⓪ *      A5: Array [ItemNr] of boolean "Item ist eingetragen"⓪ *          (A5 liegt vor A3, wichtig für Platzprüfung)⓪ *⓪ *      (D0-D7,A0)⓪ *⓪ *      A4 = ^wachsenden PlaTree⓪ *)⓪ ⓪ PROCEDURE PlaTre;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.L  (A6),D2       ;globale ID-Baum Ebene⓪)BEQ.L   PlaTre1       ; ist leer⓪)MOVE.L  A4,D0         ;Abs. Adresse des gepl. Baums⓪)MOVE.L  Header,A3       ;Code-Anfang⓪)SUB.L   A3,D0         ;Offset zum gepl. Baum⓪)MOVE.L  D0,8(A3)      ;^geplaetteten Baum⓪)⓪)MOVE.L  A1,D0⓪)ADD.L   TreSpc,D0⓪)SUB.L   A4,D0         ;Platz zwischen Codeende und Baum⓪)⓪); für jedes Item brauchen wir > 6 Byte im Code, 4 in der Liste der⓪); Basisadressen, 1 in der Flag-Liste.⓪); Wir vergeben D0/2, D0/8 * 3, D0/8. Dann läuft ggf. das Codefile⓪); zuerst über, und wir müssen nur da den Platz prüfen.⓪)⓪)LSR.L   #1,D0⓪)BCLR    #0,D0⓪)LEA     0(A4,D0.L),A5 ;Flags 'eingetragen'⓪)LSR.L   #2,D0⓪)BCLR    #0,D0⓪)LEA     0(A5,D0.L),A3 ;Liste der BasisAdr⓪)⓪)CLR.W   D5            ;ItemNr.-Zaehler⓪)CLR.W   D4            ;nur exportierte IDs kopieren⓪)JSR     PlaTre2       ;alle exportierten Items kopieren⓪ ⓪); nun noch die benutzten, benamten & anonymen Eintraege kopieren⓪ ⓪)CLR.W   D7⓪ !PlaTre8 ADDQ.W  #1,D7⓪)CMP.W   D5,D7⓪)BHI     PlaTre7⓪)MOVE.B  -1(A5,D7.W),D0;schon eingetragen?⓪)BEQ     PlaTre8       ; ja⓪)⓪)CMPI.B  #3,D0         ;mit Namen (nicht-anonym) nachtragen?⓪)BNE     anonym        ; nein⓪)⓪)MOVE.W  D7,D0⓪)LSL.W   #2,D0⓪)MOVE.L  -4(A3,D0.W),D2 ;^ItemAdr im OriginalBaum⓪)JSR     GetNameOfId    ;^Namen holen⓪)TST.L   D4⓪)BEQ     error          ;wenn EnumTyp benamt, müssen es die Elems auch⓪)⓪)MOVE.W  D7,D0⓪)BSET    #15,D0        ;als exportiert kennzeichnen⓪)MOVE.W  D0,(A4)+      ;ItemNr -> PlaTree⓪)MOVE.L  A4,A0         ;^naechsten Eintrag hier nachtragen⓪)ADDQ.L  #2,A4         ;Platz f. ^next freimachen⓪ !PlaTre5 SUBQ.L  #1,D4⓪)MOVE.B  0(A1,D4.L),(A4) ;Namen kopieren⓪)CMPI.B  #$FE,(A4)+⓪)BCS     PlaTre5        ;< $FE -> Id geht weiter⓪)BTST    #0,D4          ;ungerade Adr?⓪)BNE     PlaTre5        ; ja, Sync kopieren⓪)BRA     cont⓪ ⓪ error    MOVE    #rEnuEx,D5     ;"Fehler bei Export von Enum-Elem"⓪)JMP     SyntaxErr⓪ ⓪ anonym   MOVE.W  D7,(A4)+      ;ItemNr -> PlaTree⓪)MOVE.L  A4,A0         ;^naechsten Eintrag hier nachtragen⓪)MOVE.L  #$FEFF,(A4)+  ;leerer Name -> PlaTree⓪)MOVE.W  D7,D0⓪)LSL.W   #2,D0⓪)MOVE.L  -4(A3,D0.W),D2 ;^ItemAdr im OriginalBaum⓪)MOVE    D7,D0⓪ ⓪ cont     JSR     CopInf        ;Beschreibung kopieren⓪)CMPA.L  A4,A5         ;Beschreibung in Flagfeld gelaufen ?⓪)BHI     PlaTre8⓪ ⓪)MOVE    #rExpOv,D5    ;not enough room for Export⓪)JMP     SyntaxErr⓪ ⓪ PlaTre7  CLR.W   (A4)+⓪)MOVE.L  Header,A0⓪)MOVE.W  D5,12(A0)    ;Anzahl exp. Items⓪ PlaTre1⓪ END⓪ END PlaTre;⓪ ⓪ (*;⓪ ;   ----------------------------------⓪ ;   ID-Baum durchsuchen und in PlaTree kopieren⓪ ;   ----------------------------------⓪ ;⓪ ;       (D1,A0)⓪ ;⓪ ;       D2 = ^Baum-Wurzel⓪ ;       D4 = "auch nicht explizit exportierte IDs kopieren"⓪ ;       A4 = ^wachsenden PlaTree⓪ ;*)⓪ PROCEDURE PlaTre2;⓪ BEGIN⓪ ASSEMBLER⓪*MOVE.L  D2,-(A7)⓪*MOVE.L  -4(A1,D2.L),D2 ;linker Ast⓪*BEQ     PlaTre3⓪*JSR     PlaTre2⓪ !PlaTre3  MOVE.L  (A7),D2⓪*MOVE.L  -8(A1,D2.L),D2 ;rechter Ast⓪*BEQ     PlaTre4⓪*JSR     PlaTre2⓪ !PlaTre4  MOVE.L  (A7)+,D2      ;Knoten bearbeiten⓪ ⓪*MOVE.L  A4,A0         ;hier ItemNr und ^next nachtragen⓪*ADDQ.L  #4,A4⓪*MOVE.W  D4,-(A7)      ;D4-Flag auf Stack retten⓪*MOVE.L  D2,D4         ;Adr. der ID f. IDfromTree merken⓪*SUBQ.L  #8,D2⓪ !PlaTre5  SUBQ.L  #1,D2⓪*MOVE.B  0(A1,D2.L),(A4) ;Namen kopieren⓪*CMPI.B  #$FE,(A4)+⓪*BCS     PlaTre5        ;< $FE -> Id geht weiter⓪*BTST    #0,D2          ;ungerade Adr?⓪*BNE     PlaTre5        ; ja, Sync kopieren⓪*MOVE.W  -2(A1,D2.L),D0⓪ ⓪*TST.W   (A7)⓪*BNE     PlaTre12       ;alles kop. (auch Importe & nicht-Exportierte)⓪*BTST    #13,D0         ;importierter ID?⓪*BNE     PlaTre9        ; ja, nicht übernehmen⓪*TST.W   AllExp         ;alles exportieren (keine Liste?)⓪*BNE     PlaTre12       ; ja⓪*BTST    #14,D0         ;In Exportliste?⓪*BEQ     PlaTre9        ; nein, nicht übernehmen⓪ !PlaTre12⓪*BCLR    #6,-2(A1,D2.L) ;ggf.Export-Flag löschen⓪*TST.B   D0             ;Relay?⓪*BNE     noRel⓪*MOVE.L  -6(A1,D2.L),D2⓪ noRel     MOVE.L  D2,D1⓪*JSR     ItemNr         ;ItemNr zuweisen⓪*CLR.B   -1(A5,D0.W)    ;als fertig markieren⓪ ⓪ !PlaTre14 BSET    #15,D0         ;Als exportiert markieren⓪ !PlaTre13 MOVE.W  D0,(A0)+⓪*JSR     CopInf         ;ID-Beschreibung kopieren⓪*CMPA.L  A4,A5          ;Beschreibung in Flagfeld gelaufen ?⓪*BLS     noRoom⓪ PlaTre1   MOVE    (A7)+,D4⓪*RTS⓪ noRoom    MOVE    #rExpOv,D5    ;not enough room for Export⓪*JMP     SyntaxErr⓪ !PlaTre9  MOVE    (A7)+,D4⓪*MOVE.L  A0,A4          ;cancel begonnenen Eintrag⓪ END⓪ END PlaTre2;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Beschreibung eines Baumeintrags plaetten;⓪ *      nicht zustaendig fuer Kopieren des Namens!⓪ *   ----------------------------------⓪ *⓪ *      (D0,D2-D4,A4)⓪ *⓪ *      D0 = eigene Item-Nr (für Key-Berechnung & Export-Flag)⓪ *      D2 = rel. ^Beschreibung im ID-Baum⓪ *      A0 = Adr zum Nachtragen des ^next Item im PlaTree⓪ *      A4 = ^wachsenden PlaTree⓪ *      A3 = ^Array [ItemNr] of ID-Baum Adresse⓪ *)⓪ PROCEDURE CopInf;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.L  A0,-(A7)      ;hier ^naechsten Eintrag nachtragen⓪)MOVE    D0,-(A7)      ;Export-Flag merken⓪)CMPA.L  A4,A3⓪)BLS     ER98         ;kein Platz mehr fuer PlaTree⓪)BRA     OK⓪ !ER98    MOVE    #rDefOv,D5⓪)JMP     SyntaxErr⓪ ⓪);Modul-Key erstellen⓪ ⓪ !OK      MOVE.L  KEY,D3⓪)EXT.L   D0⓪)ADD.L   D0,D3          ;Key mitrechnen⓪)ROL.L   #1,D3⓪)⓪)SUBQ.L  #2,D2⓪)MOVEQ   #0,D0⓪)MOVE.W  0(A1,D2.L),D0  ;Kennung des Eintrags⓪)MOVE.W  D0,(A4)+⓪)⓪)ADD.L   D0,D3         ;Key mitrechnen⓪)ROL.L   #1,D3⓪)⓪)CMPI.B  #31,D0⓪)BEQ.W   CopInf11     ;String Const geht mal wieder anders⓪)LEA     ITEMS,A0      ;Liste mit Item-Beschreibung⓪ ⓪ CopInf3  CMP.B   (A0)+,D0⓪)BEQ     CopInf1      ;gefunden⓪ CopInf2  TST.B   (A0)+        ;nicht gefunden: Ende des Eintrags suchen⓪)BNE     CopInf2⓪)TST.B   (A0)         ;Ende der Liste?⓪)BNE     CopInf3      ; nein⓪)JSR     IDfromTree⓪)MOVE    #rBdExp,D5   ; ja, exp. Item ist nicht definiert⓪)JMP     SyntaxErr⓪ ⓪ CopInf1  MOVE.B  (A0)+,D0     ;Beschreibung kopieren⓪)BEQ.L   CopInf4      ;fertig⓪)CMPI.B  #1,D0        ;Ptr?⓪)BEQ     CopInf10⓪)CMPI.B  #5,D0        ;^ID? (Enum-Typ auf -Elems), geht wie Ptr⓪)BEQ     CopInf10⓪)CMPI.B  #8,D0        ;^ID? (Enum-Elem-Kette), geht wie Ptr⓪)BNE     CopInf5⓪ ⓪); Pointer und ID kopieren⓪ ⓪ CopInf10 MOVE.B  D0,-(A7)⓪)SUBQ.L  #4,D2⓪)MOVE.L  0(A1,D2.L),D1⓪)JSR     ItemNr⓪)MOVE.W  D0,(A4)+⓪)EXT.L   D0⓪)ADD.L   D0,D3         ;Key mitrechnen⓪)ROL.L   #1,D3⓪)CMPI.B  #1,(A7)+      ;war es ^ID?⓪)BEQ     CopInf1       ; nein, dann fertig⓪)⓪); Sonderbehandlung bei IDs (Enum-Elementen)⓪)⓪)TST.B   -1(A5,D0.W)   ;war sie schon mit Namen eingetragen?⓪)BEQ     CopInf1       ; ja: dann ists ja schön.⓪)TST.W   (A7)          ;Ist Enum-Typ als exportiert markiert?⓪)BPL     CopInf1       ; nein, dann nur anonym nachtragen⓪)MOVE.B  #3,-1(A5,D0.W); ja: zum nicht-anonymen Nachtragen markieren⓪)BRA     CopInf1⓪ ⓪ CopInf5  CMPI.B  #2,D0         ;Const.L?⓪)BNE     CopInf6⓪)⓪); Constant.Long kopieren⓪)⓪)SUBQ.L  #4,D2⓪)MOVE.L  0(A1,D2.L),D0⓪)ADD.L   D0,D3         ;Key mitrechnen⓪)ROL.L   #1,D3⓪)MOVE.L  D0,(A4)+⓪)BRA     CopInf1⓪ ⓪ CopInf6  CMPI.B  #3,D0         ;Const.W?⓪)BNE     CopInf7⓪)⓪); Constant.Word kopieren⓪)⓪)SUBQ.L  #2,D2⓪)MOVEQ   #0,D0⓪)MOVE.W  0(A1,D2.L),D0⓪)ADD.L   D0,D3         ;Key mitrechnen⓪)ROL.L   #1,D3⓪)MOVE.W  D0,(A4)+⓪)BRA     CopInf1⓪ ⓪ CopInf7  CMPI.B  #4,D0        ;Unterbaum?⓪)BNE     CopInf13⓪)⓪); Unterbaum kopieren⓪);⓪); VORSICHT: Der Ptr auf den Unterbaum muß unmittelbar vor dem⓪);  Baum stehen! Zwar würde CopInf hier auch mit andern Fällen⓪);  klarkommen, beim Importieren würde es dann aber schiefgehen,⓪);  weil dort der Baum immer direkt nach seinem Ptr abgelegt wird!⓪)⓪)SUBQ.L  #4,D2⓪)MOVEM.L A0/D2,-(A7)⓪)MOVE.L  0(A1,D2.L),D2⓪)BEQ     CopInf8      ;Unterbaum ist leer⓪)MOVE.L  D4,-(A7)⓪)MOVEQ   #1,D4        ;auch Importe und nicht exportierte IDs kopieren⓪)MOVE.L  D3,KEY⓪)JSR     PlaTre2⓪)MOVE.L  KEY,D3⓪)MOVE.L  (A7)+,D4⓪ CopInf8  CLR.W   (A4)+        ;Endmarke Unterbaum⓪)MOVEM.L (A7)+,A0/D2⓪)BRA     CopInf1⓪)⓪); Insert-Anweisung in der Items-Tabelle ist hier zu überspringen!⓪ ⓪ CopInf13 CMPI.B  #7,D0⓪)BNE     CopInf15⓪)MOVEQ   #0,D0⓪)MOVE.B  (A0)+,D0⓪)SUB.L   D0,D2⓪)BRA     CopInf1⓪)⓪); Constant mit var. Laenge kopieren⓪)⓪ CopInf15 SUBQ.L  #2,D2             ;muss Konst. mit variabler Laenge sein⓪)MOVE.W  0(A1,D2.L),D0     ;Laengenangabe⓪)MOVE.W  D0,(A4)+⓪ CopInf14 MOVE.L  -4(A1,D2.L),D1    ;Key mitrechnen⓪)ADD.L   D1,D3             ;Key mitrechnen⓪)ROL.L   #1,D3⓪)MOVE.L  D1,(A4)+          ;in Long-Portionen kopieren⓪)SUBQ.L  #4,D2⓪)SUBQ.W  #4,D0⓪)BGT     CopInf14⓪)BRA     CopInf1⓪ ⓪); alten String-Literal kopieren⓪ ⓪ CopInf11 CLR.W   D1              ;String-Konstante⓪)MOVEQ   #0,D0⓪)MOVE.B  -1(A1,D2.L),D1  ;Zeichenzahl⓪ CopInf12 SUBQ.L  #1,D2           ;String kopieren⓪)MOVE.B  0(A1,D2.L),D0⓪)MOVE.B  D0,(A4)+⓪)ADD.L   D0,D3         ;Key mitrechnen⓪)ROL.L   #1,D3⓪)DBF     D1,CopInf12⓪)MOVE.L  A4,D0          ; SYNC A4⓪)LSR     #1,D0⓪)BCC     CopInf4⓪)CLR.B   (A4)+⓪ ⓪); Ende der Beschreibung des Items⓪)⓪ CopInf4  ADDQ.L  #2,A7⓪)MOVE.L  (A7)+,A0⓪)MOVE.L  A4,D0⓪)SUB.L   A0,D0⓪)MOVE.W  D0,(A0)       ;rel. ^next nachtragen⓪)MOVE.L  D3,Key⓪"END⓪ END CopInf;⓪ ⓪ (* §§§⓪ *   ----------------------------------⓪ *   Kopf der Importliste erstellen;⓪ *      jeweils fuer EIN Import-Statement⓪ *   ----------------------------------⓪ *⓪ *      (D0)⓪ *⓪ *      A0 = ^importiertes DefModul⓪ *      A4 = ^anzulegende ImpListe⓪ *      TOI = Name des DefModuls, bleibt da!⓪ *⓪ *      ILstart := Startadr der Importliste⓪ *      ILEnd   := EndAdr der Importliste⓪ *)⓪ PROCEDURE SETILST;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.L  A0,-(A7)⓪)MOVE.L  A4,ILSTART⓪)MOVE.L  4(A0),(A4)+   ;Modul Key⓪)MOVE.L  4(A0),CurrentKey⓪)CMPI.W  #3,IPFLAG⓪)BNE     SETILST0⓪)MOVE.W  12(A0),(A4)+   ;bei Import in Def.Modul: Anz. Items⓪)MOVE.W  #1,(A4)+       ;bei Defmods: Flag f. <Modulname vorhanden>⓪ SETILST0 ; Modulnamen in Importliste kopieren⓪)JSR     LOOKID⓪)MOVEQ   #modnamelen,D0 ;max. Char-Zahl⓪ SETILST1 MOVE.B  (A0)+,(A4)+   ;Namen kopieren⓪)DBEQ    D0,SETILST1⓪)SUBQ.L  #1,A4⓪)MOVE.W  A4,D0⓪)BTST    #0,D0         ;Sync⓪)BNE     SETILST2⓪)MOVE.B  #$FE,(A4)+⓪ SETILST2 MOVE.B  #$FF,(A4)+    ;Endmarke⓪ SETILST4 MOVE.L  A4,ILEND⓪)MOVE.L  (A7)+,A0⓪ END⓪ END SETILST;⓪ ⓪ (*⓪!*   ----------------------------------⓪!*   Neubildliste fuer Import suchen / ggf. neu erstellen⓪!*   ----------------------------------⓪!*⓪!*      (D0/D1)⓪!*⓪!*      A5 = ^Block der Neubildlisten⓪!*      D3 = Key des gesuchten Moduls⓪!*      D4 = Anzahl Items (fuer Neueintrag benoetigt)⓪!*      D5 = StartAdr des DefMod, für das die Liste angelegt wird⓪!*           (für Platzprüfung)⓪!*⓪!*      A3 := ^Anfang der Neubildliste⓪!*      Zero-Flag := 'ok - kein Ueberlauf'⓪!*)⓪ ⓪ FORWARD Pseudo;⓪ FORWARD SysMod;⓪ FORWARD SysModEnd;⓪ ⓪ PROCEDURE Neubild;⓪ BEGIN⓪ ASSEMBLER⓪*CLR.L   D0⓪ Neubild1  MOVE.L  0(A5,D0.L),D1  ;bestehende Liste durchsuchen: Key⓪*BEQ     Neubild2      ;kein Modul mehr da⓪*CMP.L   D3,D1         ; = Key des geladenen Moduls?⓪*BEQ     Neubild3⓪*ADD.L   4(A5,D0.L),D0 ;^naechstes Modul⓪*BRA     Neubild1⓪ Neubild2  MOVE.L  D3,0(A5,D0.L)  ;neue Liste: Key eintragen⓪*MOVE.W  D4,D2         ;Anzahl Items⓪*MULU    #6,D4         ;benoetigter Platz⓪*ADD.L   #14,D4        ;Offset fuer Key/^next/items/dummy0⓪*MOVE.L  D4,4(A5,D0.L)⓪*;MOVE.W  D2,8(A5,D0.L)⓪*LEA     08(A5,D0.L),A3⓪*MOVE.L  A3,D1         ;^Anfang der Liste merken⓪*MOVEQ   #0,D0⓪ Neubild4  MOVE.W  D0,(A3)+      ;alle Items undefiniert⓪*MOVE.L  D0,(A3)+⓪*DBF     D2,Neubild4⓪*CLR.L   (A3)+         ;Endmarke⓪*CMP.L   #SysModEnd,D5⓪*BHI     Neubild6      ;hinter SysMod: Platzpruefung notwendig⓪*CMP.L   #Pseudo,D5⓪*BCC     Neubild5      ;in System oder Pseudo: keine Platzprobleme⓪ Neubild6  CMP.L   A3,D5         ;sonst pruefen:⓪*BLS     ImpOv         ;A3 >= Adr des geladenen Moduls: Ueberlauf⓪ Neubild5  MOVEA.L D1,A3         ;^neue Liste -> A3⓪*CLR.W   D0            ;setze Zero-Flag als Erfolgsmeldung⓪*RTS⓪ ImpOv     MOVEQ   #1,D0         ;Fehler signalisieren⓪*RTS⓪ Neubild3  LEA     08(A5,D0.L),A3 ;^bestehende Liste -> A3⓪@;zurueck mit Zero-Flag = 1⓪ END⓪ END Neubild;⓪ ⓪ (* §§§⓪ *   ----------------------------------⓪ *   Neubildlisten fuer Importe eines DefModuls anlegen;⓪ *      in der eigenen NeubildListe CrossRef-Verweise⓪ *      auf die Ursprungs-Module eintragen⓪ *   ----------------------------------⓪ *⓪ *      (A2: ZW fuer ^eigene Neubildliste <A3>, D0-D4)⓪ *⓪ *      A0 = ^importierendes DefModul⓪ *      A3 = ^dessen Neubildliste⓪ *)⓪ PROCEDURE CrosRef;⓪ BEGIN⓪ ASSEMBLER⓪)MOVEM.L A0/A2/A3,-(A7)⓪)MOVE.L  A3,A2⓪)MOVE.L  A0,D5         ;für Platzcheck in Neubild⓪)ADDA.L  14(A0),A0     ;^ImportListe⓪ CrosRef1 MOVE.L  (A0)+,D3      ;Key⓪)BEQ     CrosRef2      ; Ende der ImportListe⓪)MOVE.W  (A0)+,D4      ;Anzahl Items⓪)BEQ     CrosRef2      ; nix⓪)JSR     Neubild       ;Liste suchen/anlegen⓪)BEQ     CrosRef3      ;alles ok⓪)⓪)MOVEM.L (A7)+,A0/A2/A3⓪)MOVE    #rImpOv,D5    ;Fehler in Neubild: waechst in geladenes Modul!⓪)JMP     SyntaxErr⓪ ⓪ CrosRef3 ; MOVE.W  (A0)+,D0⓪); CMP.B   #$FE,D0       ;Modulnamen bis zur Endmarke ueberspringen⓪); BCS     CrosRef3⓪ ⓪ CrosRef4 MOVE.W  (A0)+,D0      ;fremde ItemNr⓪)BEQ     CrosRef1      ; Ende dieses Imports⓪)BCLR    #15,D0        ;Var/Proc-Flag in alten Compiler-Versionen⓪)MOVE.W  (A0)+,D1      ;eigene ItemNr⓪)BEQ     CrosRef4      ; ist gar nicht vergeben⓪)MULU    #6,D1⓪)MULU    #6,D0⓪)ADD.L   A3,D0         ;^Neubild im UrsprungsModul⓪)CMPI.L  #$FFFF,D1     ;prüfen wg. (An,D1.W)⓪)BLS     ok2⓪)TRAP    #6⓪)DC.W    -101          ;um internen Fehler zu melden⓪%ok2 MOVE.W  #4,0(A2,D1.L)  ;im importierenden Modul als CrossRef markieren⓪)MOVE.L  D0,2(A2,D1.L) ;und ^Ursprung eintragen⓪)BRA     CrosRef4⓪ CrosRef2 MOVEM.L (A7)+,A0/A2/A3⓪ ⓪ END⓪ END CrosRef;⓪ ⓪ (*⓪!*   ----------------------------------⓪!*   Definitions-Modul laden, Format pruefen⓪!*   ----------------------------------⓪!*⓪!*     (D0-D5)⓪!*⓪!*     TOI = Modulname, bleibt da!⓪!*     A4+$6000 = Lade-Adresse⓪!*⓪!*     A0 := StartAdr des Moduls⓪!*     Zero-Flag := "Modul gefunden"⓪!*⓪!*     LOADDEF jetzt im CompIO Modul⓪!*)⓪ ⓪ (*⓪!*   ----------------------------------⓪!*   Definitions-Modul laden & vorbereiten (fuer normalen Import):⓪!*      Importliste erzeugen,⓪!*      eigene Neubildliste und CrossRefs anlegen⓪!*   ----------------------------------⓪!*⓪!*      (D0-D5)⓪!*⓪!*      TOI = Modulname, bleibt da!⓪!*      A4 = ^erzeugten Code⓪!*⓪!*      A0 := ^DefModul⓪!*      A3 := ^Neubildliste des DefModul⓪!*      Zero-Flag := "DefMod gefunden"⓪!*)⓪ ⓪ PROCEDURE SetDef;⓪ BEGIN⓪ ASSEMBLER⓪)MOVEM.L A2/D3,-(A7)⓪)MOVE.W  OLDSBL,-(A7)⓪)LEA     SysName(pc),A2   ;TextPointer auf 'SYSTEM' stellen⓪)MOVE.W  #1,NoReload  ;Reload verhindern⓪)JSR     OldId⓪)CLR.W   NoReload⓪)MOVE.W  (A7)+,OLDSBL⓪)MOVEM.L (A7)+,A2/D3⓪)MOVE.L  A5,-(A7)⓪)JSR     CheckId       ;ist 'System' auf dem Stack?⓪)MOVE.L  (A7)+,A5⓪)BNE     normLoad⓪)LEA     SysMod,A0⓪)BRA     cont⓪ normLoad JSR     LOADDEF       ;DefModul laden, Adr in A0⓪)BNE     SetDef1       ;not avail.⓪ cont     JMP     SetDef0⓪ SysName  ACZ     'SYSTEM'⓪)SYNC⓪ SetDef1⓪ END⓪ END SetDef;⓪ ⓪ PROCEDURE SetDef0;⓪ BEGIN⓪ ASSEMBLER⓪); === Einsprung ImPseud⓪)MOVE.L  A0,CurrentDef ;Adr des bearbeiteten DefMod⓪)JSR     SETILST       ;ImpListe auf (A4)...⓪)MOVE.L  4(A0),D3      ;Key des geladenen Moduls⓪)MOVE.W  12(A0),D4     ;Anzahl der dekl. Items⓪)SUBA.L  A3,A3         ;Neubildliste erstmal auf NIL⓪)BEQ     SetDef1       ; keine⓪)⓪); glob. Flag setzen, ob Real-Consts umgewandelt werden müssen⓪)CLR     mustChgFormat  ;defaultwert⓪)CLR     D1⓪)MOVE.B  1(A0),D1       ;Enthält Modul Real-Consts?⓪)ANDI.B  #$60,D1⓪)LSR     #5,D1⓪)BEQ     noChg          ;NEIN⓪)LSR     #1,D1          ;D1 enth. Format der Reals im Def-Mod⓪)MOVE    UseFormat,D0⓪)CMPI    #3,D0⓪)BCS     retUse⓪)MOVE    SysFormat,D0⓪'retUse                   ;D0 enth. nun Ziel-Format⓪)TST     D0⓪)SNE     D0⓪)ANDI    #1,D0⓪)CMP     D0,D1⓪)BEQ     noChg⓪)MOVE    #1,mustChgFormat⓪)MOVE    D1,defFormat⓪'noChg⓪)⓪)MOVE.L  A0,D5         ;für Platzprüfung⓪)JSR     Neubild       ;Neubildliste suchen/anlegen⓪)BEQ     ok⓪)MOVE    #rImpOv,D5    ;Fehler in Neubild: waechst in geladenes Modul!⓪)JMP     SyntaxErr⓪ ok       JSR     CrosRef       ;Neubildlisten fuer Importe dieses DefMod⓪)CLR.W   D0⓪ SetDef1⓪ END⓪ END SetDef0;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Importlisten vorbereiten fuer gesamten Import-Teil,⓪ *       Platzverteilung bestimmen:⓪ *   ----------------------------------⓪ *⓪ *      A5 := ^Block der Neubild-Listen⓪ *⓪ *      vorläufige Verteilung des Platzes:⓪ *       je 1/8 für Code (Imp.Listen), Neubildlisten, DefModul, 5/8 für Tree⓪ *)⓪ PROCEDURE INITIMP;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.L  A1,D0⓪)ADD.L   TreSpc,D0     ;Untergrenze des Baums⓪)SUB.L   A4,D0         ;Platz zw. Code und Baum⓪)LSR.L   #3,D0⓪)BCLR    #0,D0⓪)⓪)LEA     0(A4,D0.L),A5 ;^Neubild-Listen⓪)CLR.L   (A5)          ;Endmarke⓪)⓪)ADD.L   A5,D0⓪)MOVE.L  D0,DAdr       ;dahin DefModul laden (für LoadDef)⓪ END⓪ END INITIMP;⓪ ⓪ ⓪ (*⓪!*   ----------------------------------⓪!*      Pseudomodul importieren:⓪!*      Standardtypen in ID-Baum und TypListe eintragen;⓪!*      wenn G+ gesetzt, auch SystemModul importieren⓪!*   ----------------------------------⓪!*⓪!*      (A0,A3,D0-D4)⓪!*)⓪ PROCEDURE ImPseud;⓪ BEGIN⓪ ASSEMBLER⓪); Leernamen auf ID-Stack⓪)MOVE.L  A2,-(A7)⓪)LEA     empty(PC),A2⓪)JSR     PushID⓪)MOVE.L  (A7)+,A2⓪)⓪)MOVE.W  D3,-(A7)⓪)MOVE.L  Options,D0⓪)BTST    #7,D0        ;Gepard-Standard?⓪)BEQ     noGep        ;noe⓪)LEA     SysMod,A0    ;*** Systemmodul pervasive importieren:⓪)JSR     SetDef0      ;Neubildliste eintragen⓪)MOVE.W  #$FFFF,PERVIMP⓪)JSR     ImpAll       ;Import pervasive⓪ noGep    LEA     Pseudo,A0    ;*** PseudoModul pervasive importieren:⓪)JSR     SetDef0      ;Neubildliste eintragen⓪)MOVE.W  #$FFFF,PERVIMP⓪)JSR     ImpAll       ;Import pervasive⓪)LEA     INTPTR,A0⓪)ADDQ.L  #6,A3⓪)MOVEQ   #18,D0        ;Anzahl der Std-Types minus Eins⓪ ImPseud1 ADDQ.L  #2,A3⓪)MOVE.L  (A3)+,(A0)+   ;^Standard-Typen kopieren⓪)DBF     D0,ImPseud1⓪)MOVE.L  SSTyp,StrPtr⓪)MOVE.W  (A7)+,D3⓪)JMP     MyPullID      ;Name wieder von Stack holen⓪ empty:   DC.W    0⓪ END⓪ END ImPseud;⓪ ⓪ (*⓪!*   ----------------------------------⓪!*   Baumeintragungen und Importlisten anlegen⓪!*   ----------------------------------⓪!*)⓪ PROCEDURE InitImports;⓪"BEGIN⓪$ASSEMBLER⓪(JSR     INITIMP       ;Neubildlisten vorbereiten⓪(MOVE.L  A4,D0         ;bei Pgm/DefMod:⓪(MOVE.L  Header,A0⓪(SUB.L   A0,D0⓪(MOVE.L  D0,14(A0)    ;^ImportListe anlegen⓪(JSR     ImPseud⓪(; Nun sind CardRel/IntRel init. -> $I-Option kann ausgewertet werden:⓪(JSR     validateOpts⓪$END⓪"END InitImports;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Import-Statements uebersetzen⓪ *   ----------------------------------⓪ *⓪ *     (D0-D5,A0)⓪ *⓪ *     D3 = 1. Symbol (IMPORT/FROM, falls vorhanden)⓪ *⓪ *     D3 := Symbol nach ';'⓪ *     A3 := Platzbedarf der imp. Variablen⓪ *⓪ * Um die Probleme mit Enums zu lösen, wird nun wie folgt vorgegangen:⓪ * (TT 22.10.90)⓪ *⓪ *  1. Wenn alles importiert wird (also ohne FROM, über 'ImpAll'), werden⓪ *     ja auch alle vorhandenen IDs durchgegangen, sodaß auch die Enum-Elems⓪ *     in der "Importliste" vorkommen. Daher ist es dann egal, ob die⓪ *     Enum-Elems anonym oder benamt nachgefordert werden, wenn der Typ⓪ *     zuerst dran kommt: Irgendwann kommen die Elems nach und werden mit⓪ *     Namen nachgetragen. Daher wäre der Wert in "anonFlag" bei 'ImpAll' egal.⓪ *     Damit es aber erst gar nicht bei Import von Strukturen, die wiederum⓪ *     Enum-Typen aus anderen Modulen benutzen, evtl. zu benamten Importen⓪ *     kommt, ist "anonFlag" generell 2 (anonyme Eintragung von Enum-Elems).⓪ *  2. Wenn einzeln über FROM importiert wird, ist eine Unterscheidung zw.⓪ *     Enum-Typ und -Elem zu treffen: Wird ein Enum-Typ importiert, müssen⓪ *     die Namen der Elems unbedingt nachgefordert werden (Kennung 7 bei⓪ *     ItemAdr). Wird ein Enum-Elem importiert, müssen dagegen die Verweise⓪ *     auf die ggf. weiteren Elems anonym nachgetragen werden.⓪ *  Die Var 'explicitImport' wird bei FROM ... IMPORT auf TRUE gesetzt,⓪ *  um den 2. Fall zu erkennen (in ImpItm16 und ScanItm).⓪ *  Die Kennung 3 in der Neubildliste kommt nur noch bei Enum-Elems vor, bei⓪ *  denen der Enum-Typ mit FROM importiert wurde. So werden mit dieser Kennung⓪ *  praktisch explizite FROM-Importe der Elems simuliert. Wenn diese Kennung 3⓪ *  mit einem weiteren expliziten Import kollidiert, ist dies ein Fehler wg.⓪ *  Doppel-Imports eines Enum-Elems.⓪ *)⓪ ⓪ PROCEDURE GlobImp;⓪ BEGIN⓪ ASSEMBLER⓪)JSR     InitImports⓪)CMPI.W  #3,IPFLAG     ;DefMod?⓪)BEQ     GlobImp6⓪)MOVE.L  OPTIONS,D1⓪)BTST    #14,D1⓪)BNE     GlobImp6⓪)JSR     Runtime       ; weder noch: Runtime importieren⓪ GlobImp6 CMPI.W  #69,D3        ;IMPORT?⓪)BNE     GlobImp7⓪ GlobImp5 JSR     GETID         ;* IMPORT modulname *⓪)JSR     SetDef        ;DefModul laden & vorbereiten⓪)BEQ     OK⓪)MOVE    #rNoDef,D5         ;nicht gefunden⓪)JMP     SyntaxErr⓪ !OK      MOVE.W  2(A0),D1⓪)CMPI.W  #1,D1         ;ist Export qualified?⓪)BNE     GlobImp2⓪)JSR     ImpQual       ; ja⓪)BRA     GlobImp3⓪ GlobImp2 CMPI.W  #2,D1         ;ist Export pervasive?⓪)BNE     GlobImp4⓪)JSR     ImpPer        ; ja⓪)BRA     GlobImp3⓪ GlobImp4 JSR     ImpGlob       ;unqualified Export⓪ GlobImp3 JSR     GetSbl⓪)CMPI.W  #10,D3        ;',' ?⓪)BEQ     GlobImp5      ;weitere ModulNamen⓪)CMPI.W  #11,D3⓪)BEQ     OK1⓪)MOVE    #rSemXp,D5          ;muss ';' folgen⓪)JMP     SyntaxErr⓪ !OK1     JSR     GetSbl⓪)BRA     GlobImp6⓪ GlobImp7 CMPI.W  #68,D3        ;FROM?⓪)BNE.W   GlobImp1⓪)JSR     OLDID         ;* FROM modulname IMPORT *⓪)JSR     GetSbl⓪)CMPI.W  #69,D3        ;IMPORT?⓪)BEQ     OK2⓪)MOVE    #rImpXp,D5         ; muss folgen⓪)JMP     SyntaxErr⓪ !OK2     JSR     SetDef        ;laden & vorbereiten⓪)BEQ     OK10⓪)MOVE    #rNoDef,D5         ;nicht gefunden⓪)JMP     SyntaxErr⓪ !OK10    JSR     MyPullId⓪)CLR.W   PERVIMP⓪ GlobImp8 JSR     FromImp       ;einen ID importieren⓪)MOVE.L  A0,-(A7)⓪)JSR     GetSbl⓪)MOVE.L  (A7)+,A0⓪)CMPI.W  #10,D3        ;,⓪)BEQ     GlobImp8      ;weitere IDs⓪)CMPI.W  #11,D3        ;;⓪)BEQ     OK3⓪)MOVE    #rSemXp,D5⓪)JMP     SyntaxErr⓪ !OK3     MOVE.L  A0,-(A7)⓪)ADDA.L  8(A0),A0⓪)JSR     ImpRest       ;Refs auf anonym benutzte Items nachtragen⓪)JSR     CloseImp      ;ImpListe: wenn leer: loeschen, sonst Endmarke⓪)MOVE.L  (A7)+,A0⓪)JSR     ImpXRef⓪)JSR     GetSbl⓪)BRA     GlobImp6⓪ GlobImp1 CLR.L   (A4)+         ;Endmarke ImportListen⓪)CMPI.W  #2,IPFLAG     ;Impl.Mod?⓪)BNE     L1⓪)JMP     OwnDef        ;eigenes DefModul laden⓪ !L1      CLR.L   VARSPC        ;kein verbrauchter Var-Platz⓪ END⓪ END GlobImp;⓪ ⓪ (*⓪$----------------------------------⓪$Import Runtime (pervasive)⓪ ⓪$prüft nebenbei die Seriennummern, die auf dem IntegerStack stehen.⓪$Im Fall eines Fehlers wird die Item-Tabelle zerschossen.⓪$----------------------------------⓪ ⓪((D0-D2,D4,D5,A0)⓪ *)⓪ PROCEDURE Runtime;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.W  D3,-(A7)⓪)MOVE.W  OLDSBL,-(A7)⓪)JSR     PullInt         ;schon mal eine Seriennummer holen⓪)MOVE.W  D0,-(A7)⓪)MOVE.L  A2,-(A7)⓪)LEA     rtName(pc),A2   ;TextPointer auf 'Runtime' stellen⓪)MOVE.W  #1,NoReload     ;Reload verhindern⓪)JSR     GETID⓪)CLR.W   NoReload⓪)MOVE.L  (A7)+,A2⓪)JSR     LOADDEF     ;Laden, vorbereiten⓪)BEQ     OK⓪)MOVE    #rRuDef,D5      ;Runtime Mod not found⓪)JMP     SyntaxErr⓪ rtName   ACZ     'Runtime'⓪)SYNC⓪ OK       JSR     SetDef0⓪)JSR     ImpPer      ;pervasive importieren⓪)⓪); Prüfung der Seriennummer⓪)⓪)JSR     PullInt     ;das ist die Original-Seriennummer⓪)MOVE    #SerCnt2,D1⓪ lp       BTST    #3,D0       ;17 bit Schieberegister, rechtsrum⓪)BEQ     noChng      ;bit17 (i+1) := bit0 (i) EOR bit3 (i)⓪)BCHG    #0,D0⓪ noChng   ASR.L   #1,D0⓪)BCC     zero⓪)BSET    #16,D0⓪ zero     DBF     D1,lp⓪)ADDI.W  #SerOffset2,D0⓪)CMP.W   (A7)+,D0⓪)BEQ     SerOk⓪)LEA     Items,A0⓪)SUBQ.B  #2,3(A0)⓪ SerOk    MOVE.W  (A7)+,OLDSBL⓪)MOVE.W  (A7)+,D3⓪ END⓪ END Runtime;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   PullID, ohne A0 zu stoeren⓪ *   ----------------------------------⓪ *⓪ *      (D0)⓪ *)⓪ PROCEDURE MyPullId;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.L  A0,-(A7)⓪)JSR     PULLID⓪)MOVE.L  (A7)+,A0⓪ END⓪ END MyPullId;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Import eines ID's nach FROM .. IMPORT⓪ *   ----------------------------------⓪ *⓪ *      (D0-D3)⓪ *⓪ *      A0 = ^DefModul⓪ *      A2 = ^Id im Programmtext⓪ *⓪ *      A2 := ^hinter Id im Text⓪ *)⓪ ⓪ PROCEDURE FromImp;⓪ BEGIN⓪ ASSEMBLER⓪*MOVE    #1,explicitImport⓪*MOVE.L  A5,-(A7)⓪*MOVE.L  A0,-(A7)⓪*JSR     GETID         ;Id aus Text holen⓪*JSR     PULLID⓪*MOVE.L  A0,A5         ;^Id⓪*MOVE.L  (A7),A0⓪*MOVE.L  8(A0),D0      ;Offset auf PlaTree⓪*BNE     OK⓪!!ER86    MOVE    #rNoExp,D5         ;keiner da -> ID nicht im DefMod⓪*JMP     SyntaxErr⓪!!OK      MOVE.L  OPTIONS,D2⓪*ADDA.L  D0,A0⓪ !FromImp1 MOVE.W  (A0)+,D5      ;ItemNr⓪*BEQ     ER86         ;Ende des PlaTree -> ID nicht im DefMod⓪*BPL     FromImp2      ;dieses Item ist nicht exportiert⓪*CLR.W   D0⓪ !FromImp3 MOVE.B  0(A5,D0.W),D1  ;Namen vergleichen:⓪*BEQ     FromImp4      ;Ende des Id im Text⓪*MOVE.B  2(A0,D0.W),D3⓪*EOR.B   D3,D1⓪*BEQ     FromImp5⓪*BTST    #3,D2         ;Case Sensitive ?⓪*BNE     FromImp2      ; ja⓪*AND.B   #$DF,D1⓪*BNE     FromImp2⓪ !FromImp5 ADDQ.W  #1,D0⓪*BRA     FromImp3⓪ !FromImp2 ADDA.W  (A0),A0       ;Item ueberspringen⓪*BRA     FromImp1⓪ !FromImp4 CMPI.B  #$FE,2(A0,D0.W)    ;Ende auch im PlaTree?⓪*BCS     FromImp2      ; nein, passt nicht⓪*MOVE.W  #7,anonFlag⓪*JSR     ImpItm20      ; ja, importieren⓪*MOVE.L  (A7)+,A0⓪*MOVE.L  (A7)+,A5⓪ END⓪ END FromImp;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Importiere komplettes Modul qualifiziert⓪ *   ----------------------------------⓪ *⓪ *      (A0,D0-D7)⓪ *⓪ *      A0 = ^geladenes DefModul⓪ *      TOI = DefModulname⓪ *)⓪ PROCEDURE ImpQual;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.L  A0,-(A7)⓪)JSR     PULLID        ;Mod.Name⓪)JSR     SETID⓪)MOVE.W  #$A010,-2(A1,D6.L) ;als Qualifier eintragen (importiert!!)⓪)SUBQ.L  #6,D6⓪)MOVE.L  D6,TRESPC⓪)MOVE.L  (A7)+,A0⓪)MOVE.L  D6,-(A7)      ;hier ^lokalen Baum nachtragen⓪)CLR.L   -(A6)         ;neues Scope⓪)CLR.W   PERVIMP       ;nicht pervasive⓪)JSR     ImpAll        ;ganzes Modul importieren⓪)MOVE.L  (A7)+,D6⓪)MOVE.L  (A6)+,0(A1,D6.L) ;^lok.Baum nachtragen⓪ END⓪ END ImpQual;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Importiere komplettes Modul, nicht qualifiziert⓪ *   ----------------------------------⓪ *⓪ *      (A0,D0-D7)⓪ *⓪ *      A0 = ^DefModul⓪ *      TOI = DefModulname⓪ *)⓪ PROCEDURE ImpGlob;⓪ BEGIN⓪ ASSEMBLER⓪)CLR.W   PERVIMP       ;nicht pervasive⓪)JSR     MyPullId      ;Modulname nicht benoetigt⓪)JSR     ImpAll        ;alles importieren⓪ END⓪ END ImpGlob;⓪)⓪ (*⓪ *   ----------------------------------⓪ *   Importiere komplettes Modul, pervasive⓪ *   ----------------------------------⓪ *⓪ *      (A0,D0-D7)⓪ *⓪ *      A0 = ^DefModul⓪ *      TOI = DefModulname⓪ *)⓪ PROCEDURE ImpPer;⓪ BEGIN⓪ ASSEMBLER⓪)CMPI.W  #3,IPFLAG     ;Import in DefMod?⓪)BNE     OK⓪)MOVE    #rPerva,D5         ; nicht erlaubt⓪)JMP     SyntaxErr⓪ !OK      MOVE.W  #$FFFF,PERVIMP⓪)JSR     MyPullId      ;Name nicht benoetigt⓪)JSR     ImpAll        ;alles importieren⓪ END⓪ END ImpPer;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Kompletten PlaTree importieren⓪ *      in ID-Baum kopieren und Importliste anlegen⓪ *   ----------------------------------⓪ *⓪ *      (D0-D7,A0)⓪ *⓪ *      A0 = ^DefMod⓪ *      pervimp = Flag "im pervasive Level eintragen"⓪ *)⓪ ⓪ PROCEDURE ImpAll;⓪ BEGIN⓪ ASSEMBLER⓪)CLR     explicitImport⓪)MOVE.L  A0,-(A7)⓪)MOVE.L  8(A0),D0      ;Offset bis PlaTree⓪)BEQ     ImpAll1       ;gar keiner da⓪)ADDA.L  D0,A0⓪)MOVE.L  A0,-(A7)⓪ ImpAll2  MOVE.W  #2,anonFlag⓪)JSR     ImpItm        ;A0=^ItemNr⓪)TST.W   (A0)⓪)BNE     ImpAll2       ;PlaTree geht weiter⓪)MOVE.L  (A7)+,A0⓪)JSR     ImpRest       ;VorwaertsRefs nachtragen⓪ ImpAll1  JSR     CloseImp      ;falls ImpListe leer, loeschen; sonst Endmarke⓪)MOVE.L  (A7)+,A0⓪)JSR     ImpXRef⓪ END⓪ END ImpAll;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Anonym benutzte Items in ID-Baum uebernehmen;⓪ *      Vorwaerts-Referenzen darauf nachtragen⓪ *   ----------------------------------⓪ *⓪ *      (D0-D7,A0)⓪ *⓪ *      A0 = ^PlaTree⓪ *)⓪ PROCEDURE ImpRest;⓪ BEGIN⓪ ASSEMBLER⓪)CLR     explicitImport⓪ IMPLOOP  MOVEM.L A0/A2,-(A7)⓪)CLR.W   D7⓪ ImpRest5 MOVE.W  (A0)+,D5      ;ItemNr aus PlaTree⓪)BEQ.W   ImpRest2      ; Ende⓪)BCLR    #15,D5        ;Export-Flag uninteressant⓪)MOVE.W  D5,D0⓪)MULU    #6,D0⓪)LEA     0(A3,D0.W),A2  ;Adr in NeubildListe⓪ ImpRest0 CMPI.W  #4,(A2)       ;CrossRef?⓪)BNE     ImpRest7⓪)MOVE.L  2(A2),A2      ; ja, im UrsprungsMod nachsehen⓪)BRA     ImpRest0⓪ ImpRest7 CMPI.W  #2,(A2)       ;VorwaertsRef drauf?⓪)BEQ     ImpRest1⓪)CMPI.W  #3,(A2)       ;nicht anon. Vorwaertsref (Enum-Element) ?⓪)BEQ     ImpRest6⓪)CMPI.W  #5,(A2)       ;Eintrag fertig, aber Name nachzuholen?⓪)BEQ     ImpRest6      ; Namen setzen, fertiger Eintrag wird bemerkt⓪)TST.W   (A2)⓪)BEQ     ImpRest8⓪)ADDA.W  (A0),A0       ;nichts zu tun⓪)BRA     ImpRest5⓪)⓪ ImpRest8 LEA     0(A3,D0.W),A2  ;Adr in NeubildListe⓪)ADDA.W  (A0),A0       ;nichts zu tun⓪)BRA     ImpRest5⓪)⓪); Items mit anonymer Vorw.Ref nachbehandeln⓪)⓪ ImpRest1 BSR.L   ImpRest3      ;VorwRef: Referenzen nachtragen⓪)MOVEQ   #1,D7⓪)BRA     ImpRest5⓪)⓪); Items nachbehandeln, die mit Namen bekannt werden dürfen⓪);  (anonyme Typbeschreibung KANN vorliegen)⓪)⓪ ImpRest6 MOVE.W  #7,anonFlag⓪)JSR     ImpItm20      ;nicht-anon. VorwRef: in ID-Baum; Refs nachtr.⓪)MOVEQ   #1,D7         ; markiere erfolgten Eintrag⓪)BRA     ImpRest5⓪ ⓪ ImpRest2 MOVEM.L (A7)+,A0/A2   ;PlaTree durch⓪)TST.W   D7            ;evtl. weitere VorwRefs entstanden?⓪)BNE     IMPLOOP       ; ja, nochmal durch⓪)RTS⓪)⓪); anonymen Eintrag nachholen (bei anon. VorwaertsRefs)⓪)⓪ ImpRest3 MOVE.W  (A0)+,D0      ;^next weg⓪ ImpRest4 MOVE.W  (A0)+,D0      ;Namen weg⓪)CMP.B   #$FE,D0⓪)BCS     ImpRest4⓪)MOVE.W  #2,anonFlag   ;auch verwiesene Eintraege bleiben anonym⓪)MOVE.L  TRESPC,D6⓪)MOVEQ   #1,D1         ;anonymer Eintrag geplant⓪)JSR     ListImp       ;schon da?⓪)JMP     ImpItm30⓪ END⓪ END ImpRest;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Importliste abschliessen;⓪ *      Gepard-CodeGen: loeschen falls leer⓪ *   ----------------------------------⓪ *⓪ *      A4 = ^Ende der fertigen Importliste⓪ *)⓪ PROCEDURE CloseImp;⓪ BEGIN⓪ ASSEMBLER⓪)CMPA.L  ILEND,A4      ;ILEnd zeigt hinter Kopf der ImpList⓪)BHI     CLIMP1⓪ (*$ ? Atari:⓪)MOVE.L  A0,-(A7)⓪)MOVE.L  ILSTART,A0⓪)CMPI.L  #PseudoKey,(A0) ;war Pseudomodul importiert ?⓪)BEQ     CLIMP2⓪)CMPI.L  #SystemKey,(A0) ;war Systemmodul importiert ?⓪ CLIMP2   MOVE.L  (A7)+,A0⓪)BNE     CLIMP1        ;wenn nicht, dann Importliste immer stehenl.⓪ *)⓪)MOVE.L  ILSTART,A4    ;keine Eintraege; Liste weg⓪)RTS⓪ CLIMP1   CLR.W   (A4)+         ;Endmarke⓪ END⓪ END CloseImp;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Implizite Importe bei IMP-Modulen nachholen.⓪ *   ----------------------------------⓪ *⓪ *   Die Module der impliziten Importliste werden in die Importliste⓪ *   übernommen und dann ihre Neubildlisten geprüft und die dort noch⓪ *   undefinierten Items in die Importliste nachgetragen.⓪ *⓪ *      (D0-D7,A0)⓪ *⓪ *      A0 = ^DefMod⓪ *      A3 = ^Neubildliste des bearbeiteten Defmods⓪ *      A5 = ^Block der Neubildlisten⓪ *)⓪ PROCEDURE ImpXref;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.L  A3,-(A7)⓪)CMPI.B  #6,(A0)       ;Dlayout⓪)BCS.W   noimports     ; altes Layout⓪)MOVE.L  30(A0),D0⓪)BEQ.W   noimports     ; keine abhängigen Module⓪)ADDA.L  D0,A0⓪ ⓪ IMPLOOP  MOVE.L  (A0)+,D3      ;Key⓪)BEQ.W   noimports     ; keine abhängigen Module⓪)MOVE.L  A4,ILSTART⓪)MOVE.L  D3,(A4)+      ;Key in Importliste eintragen⓪); Modulnamen in Importliste kopieren⓪ SETILST1 MOVE.W  (A0)+,D0      ;Modulname aus impliziter Importliste kopieren⓪)MOVE.W  D0,(A4)+⓪)CMP.B   #$FE,D0⓪)BCS     SETILST1⓪)MOVE.L  A4,ILEND⓪)⓪); Neubildliste zum Modul suchen⓪)CLR.L   D0⓪ Neubild1 MOVE.L  0(A5,D0.L),D1 ;bestehende Liste durchsuchen: Key⓪)BEQ     Neubild2      ;kein Modul mehr da⓪)CMP.L   D3,D1         ; = Key des geladenen Moduls?⓪)BEQ     Neubild3⓪)ADD.L   4(A5,D0.L),D0 ;^naechstes Modul⓪)BRA     Neubild1⓪ Neubild2                       ;dürfte nicht vorkommen⓪)TRAP    #6⓪)DC.W    -111          ;um internen Fehler zu melden⓪)BRA     Neubild2⓪)⓪ Neubild3 LEA     08(A5,D0.L),A3 ;^bestehende Liste -> A3⓪ ⓪); Schleife: in Neubild nach undefinierten Items suchen⓪)MOVE.L  4(A5,D0.L),D5⓪)SUBI.L  #14,D5⓪)DIVU    #6,D5         ;Anzahl Items⓪)BRA     next⓪ itemloop MOVE    D5,D0         ;Itemnr.⓪)MULU    #6,D0⓪)TST.W   0(A3,D0.W)    ;nachzutragen?⓪)BPL     next⓪)⓪)ANDI.W  #$FF,0(A3,D0.W) ;->ist nachgetragen⓪)MOVE    D5,(A4)+⓪)MOVE.L  A0,-(A7)⓪)MOVE.L  Header,A0⓪)MOVE.L  A4,D1⓪)SUB.L   A0,D1⓪)SUB.L   14(A0),D1     ;rel. ^Importlisten-Eintrag⓪)MOVE.L  2(A3,D0.W),D0 ;^Item in Tree⓪)MOVE.L  D1,-6(A1,D0.L);  im Baum ueber Adr-Eintrag mogeln⓪)MOVE.L  (A7)+,A0⓪)CLR.L   (A4)+         ;hier ^letzte Ref nachtragen (durch FinImp)⓪)⓪ next     DBRA    D5,itemloop⓪ ⓪)CLR.W   (A4)+         ;Endmarke des Moduls⓪)BRA     IMPLOOP       ;und nächstes Modul...⓪ ⓪ noimports:⓪);prüfen, ob alle impliziten Importe aufgelöst wurden⓪)MOVE.L  (A7)+,A3      ;Neubildliste des importierten Moduls⓪)MOVE.L  A3,D0⓪)BEQ     nobild        ;DefMod hat keine exportierten Items⓪)MOVE.L  -4(A3),D5⓪)SUBI.L  #14,D5⓪)DIVU    #6,D5         ;Anzahl Items⓪)BRA     st2⓪ lup2     MOVE    D5,D0         ;Itemnr.⓪)MULU    #6,D0⓪)LEA     0(A3,D0.W),A0⓪ lup3     CMPI    #4,(A0)       ;Crossref?⓪)BNE     st3⓪)MOVE.L  2(A0),A0⓪)BRA     lup3⓪ st3      TST     (A0)⓪)BPL     st2⓪);Fehler: es ist was übriggeblieben⓪)TRAP    #6⓪)DC.W    -112          ;um internen Fehler zu melden⓪ st2      DBRA    D5,lup2⓪ nobild:⓪ END⓪ END ImpXref;⓪ ⓪ ⓪ PROCEDURE ImportedTwice;⓪"BEGIN⓪$ASSEMBLER⓪)JSR     GetNameOfId    ;^Namen holen⓪)TST.L   D4⓪)BEQ     error          ;wenn EnumTyp benamt, müssen es die Elems auch⓪)ADDQ.L  #8,D4⓪)JSR     IDFromTree⓪)MOVE    #rId2Im,D5     ;Enum-Elem doppelt importiert⓪)JMP     SyntaxErr⓪ error    MOVE    #rEnuIm,D5     ;"Fehler bei Import von Enum-Elem"⓪)JMP     SyntaxErr⓪$END;⓪"END ImportedTwice;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Adresse eines neuen Items registrieren;⓪ *      kann auch bereits eingetragen sein (erst anonym, spaeter mit Namen).⓪ *      Evtl. vorhandene VorwRefs aufloesen⓪ *   ----------------------------------⓪ *⓪ *      (D0-D2)⓪ *⓪ *      D5 = ItemNr⓪ *      D6 = Adresse im ID-Baum⓪ *      A0 = ^Item-Beschreibung⓪ *      A3 = zustaendige NeubildListe⓪ *      D1 = einzutragende Kennung (1 oder 6)⓪ *           (wenn 1 übergeben und bisher 3 eingetragen, entsteht 5)⓪ *           (wenn 1 übergeben und bisher 6 eingetragen, bleibt 6)⓪ *           (wenn 1 übergeben und bisher 5 eingetragen, bleibt 5)⓪ *           (wenn 6 übergeben und bisher 3,5,6 eingetr., kommt Fehler)⓪ *⓪ *      ZeroFlag := "Item ist noch nicht im Baum"⓪ *      D1 := Adresse, falls schon im Baum⓪ *⓪ *      Kennung: 0=keine Referenz⓪ *               1=definiert, anonym, Adr enthaelt TreePtr⓪ *               2=VorwaertsRef anonym, Adr enthaelt ^letzte Ref⓪ *               3=VorwaertsRef w/Name,     - " -⓪ *               4=importiert, Adr enthaelt abs. ^Ursprungs-Neubild⓪ *               5=definiert, Adr enth. TreePtr, Name ist aber noch nachzu-⓪ *                 tragen (Enum-Element, wenn Enumtyp nachtr. bekannt wird)⓪ *               6=definiert, Name bekannt, Adr enthaelt TreePtr⓪ *)⓪ ⓪ PROCEDURE ListImp;⓪ BEGIN⓪ ASSEMBLER⓪*MOVE.W  D5,D0⓪*BCLR    #15,D0⓪*MULU    #6,D0⓪*MOVE.L  A3,-(A7)⓪*LEA     0(A3,D0.W),A3⓪ !ListImp6 CMPI.W  #4,(A3)       ;CrossRef (importiert)?⓪*BNE     ListImp4⓪*MOVE.L  2(A3),A3      ;im UrsprungsModul bearbeiten⓪*BRA     ListImp6⓪ !ListImp4 TST.W   (A3)⓪*BEQ.W   ListImp1      ;noch unbekannt⓪*CMPI.W  #2,(A3)⓪*BEQ     ListImp8⓪*CMPI.W  #3,(A3)⓪*BEQ     ListImp5⓪*⓪*; D1=1: 1 > 1, 5 > 5, 6 > 6⓪*; D1=6: 1 > 6, 5 > 6, 6 > 6⓪*CMP     #1,D1         ;*** Item schon bekannt⓪*BEQ     ListImp7⓪*TST.W   explicitImport ;wird das Elem mit FROM importiert?⓪*BEQ     noFrom2⓪*CMPI    #5,(A3)       ;und wird Name import., obwohl schon gefordert?⓪*BEQ     ListImp2      ;dann Fehler: doppelter Import⓪ noFrom2   MOVE.W  #6,(A3)       ;neue Kennung ('aus 1 mach 6')⓪ !ListImp7 MOVE.L  2(A3),D1      ;Adr⓪*MOVEA.L (A7)+,A3⓪*RTS⓪ ⓪ ListImp2  MOVE.L  2(A3),D6⓪ ListImp0  MOVE.L  D6,D2⓪*JMP     ImportedTwice⓪ ⓪@;*** VorwaertsRefs!⓪ !ListImp5 ; es gibt bereits eine Vorw-ref auf ein Enum-Elem (wg. Import⓪*; des Enum-Typs). Wird es nun nochmals explizit importiert,⓪*; ist das ein Fehler.⓪*CMP.B   #6,D1         ;neuer Eintrag benamt?⓪*BEQ     ListImpB⓪*MOVEQ   #5,D1         ;nein: aus 1 mach 5 (Namen nachfordern)⓪*BRA     ListImp8⓪ !ListImpB TST.W   explicitImport ;wird das Elem mit FROM importiert?⓪*BNE     ListImp0      ;dann Fehler⓪ !ListImp8 MOVE.W  D1,(A3)       ;neue Kennung ist 1, 5, oder 6⓪*MOVE.L  2(A3),D2⓪ !ListImp3 MOVE.L  0(A1,D2.L),D1 ;*** VorwRefs: Ptr-Kette abarbeiten⓪*MOVE.L  D6,0(A1,D2.L)⓪*MOVE.L  D1,D2⓪*BNE     ListImp3⓪*BRA     ListImp9⓪ ⓪ !ListImp1 ;*** unbenutztes Item⓪*(*⓪*; erstmal prüfen, ob es eine Crossref darauf war⓪*MOVE.L  A0,-(A7)⓪*MOVEA.L 4(A7),A0      ;Orig-Neubildliste⓪*LEA     0(A0,D0.W),A0⓪*CMPI.W  #4,(A0)       ;CrossRef (importiert)?⓪*BNE     ListImpA⓪*ST      UnknownCrossRef⓪ ListImpA  MOVEA.L (A7)+,A0⓪**)⓪*MOVE.W  D1,(A3)       ;zu benutztem Item machen⓪ ⓪ !ListImp9 MOVE.L  D6,2(A3)      ;^Tree setzen⓪*CLR.L   D1⓪*MOVEA.L (A7)+,A3⓪ END⓪ END ListImp;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Neue Adr eines Items bzw. Pointerketten-Link liefern⓪ *   ----------------------------------⓪ *⓪ *      D1 = ItemNr aus PlaTree⓪ *      A3 = ^Neubildliste⓪ *      D3 = Kennung, die bei Entstehen einer VorwRef einzutragen ist.⓪ *            2 = anonym, 3 = mit Namen,⓪ *            7 = Name, auch wenn schon bekannt (wird zu 3 oder 5)⓪ *      D0 := rel ^Item im IdBaum⓪ *)⓪ PROCEDURE ItemAdr;⓪ BEGIN⓪ ASSEMBLER⓪)MULU    #6,D1⓪)BEQ.W   ItemAdr6      ;nil-Ptr: Sonderfall⓪)MOVE.L  A3,-(A7)⓪)LEA     0(A3,D1.W),A3⓪ ItemAdr5 MOVE.W  (A3),D0⓪)BEQ.W   ItemAdr1      ;unbekannt⓪)CMPI.W  #4,D0         ;Import⓪)BNE     ItemAdr4⓪)MOVE.L  2(A3),A3      ;^Original-Neubildliste⓪)BRA     ItemAdr5⓪ ItemAdr4 CMPI.W  #2,D0         ;VorwRef anonym ?⓪)BEQ.W   ItemAdr2⓪)CMPI.W  #3,D0         ;VorwRef mit Namen ?⓪)BEQ.W   ItemAdr2⓪)⓪); Adresse des Items ist bekannt⓪)⓪)CMP.W   #2,D3         ;anonymer Antrag?⓪)BEQ     known         ;dann reichts schon⓪)(*⓪)CMP.W   #7,D3         ;Namenseintrag unbed. gewuenscht? -> nachfordern⓪)BEQ     getName⓪)CMP.W   #1,D0         ;Name noch unbekannt?⓪)BNE     chkName       ; nein -> ist OK⓪)*)⓪ getName  MOVE.W  #5,(A3)       ;nachfordern!⓪ chkName  SUBQ.W  #5,D0         ;wird Name bereits gesucht?⓪)BEQ     impTwice      ;ja: dann Fehler melden⓪ known    MOVE.L  2(A3),D0      ;Adresse bekannt⓪)MOVE.L  (A7)+,A3⓪)RTS⓪ impTwice MOVE.L  2(A3),D2⓪)JMP     ImportedTwice⓪ ⓪); VorwaertsRefs⓪)⓪ ItemAdr1 CMP.W   #7,D3         ;hier müssen wir aus der 7 eine 3 machen⓪)BNE     cont⓪)MOVEQ   #3,D3⓪ cont     MOVE.W  D3,(A3)       ;jetzt erstmals VorwaertsRefs entstanden⓪)CLR.L   2(A3)⓪ ⓪ ItemAdr2 MOVE.L  2(A3),D0      ;bestehende VorwRef-Kette verlaengern⓪ ItemAdr3 TST.L   D6⓪)BEQ     nolink        ;Call aus ScanItm, um Kng 3 anzumelden⓪)MOVE.L  D6,2(A3)⓪ nolink   MOVE.L  (A7)+,A3⓪)RTS⓪ ItemAdr6 CLR.L   D0⓪ END⓪ END ItemAdr;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Item in ImportListe fuer I/P-Modul eintragen;⓪ *      nur Proc/Var/neue Konst. werden eingetragen.⓪ *      Import-Flag in D0 setzen⓪ *   ----------------------------------⓪ *⓪ *      (D1)⓪ *⓪ *      D0 = Kennung des Items⓪ *      D5 = ItemNr⓪ *      D6 = neue IdBaum-Adr⓪ *      A0 = ^PlaTree (hinter Kennung)⓪ *      A3 = ^Neubildliste⓪ *      A4 = ^wachsende Importliste⓪ *)⓪ PROCEDURE IPIMP;⓪ BEGIN⓪ ASSEMBLER⓪)CMPI.B  #6,D0         ;Proc?⓪)BEQ     IPIMP1⓪)CMPI.B  #50,D0        ;neue Const?⓪)BEQ     IPIMP1⓪)CMPI.B  #17,D0        ;Var?⓪)BNE     IPIMP2⓪)BTST    #8+4,D0       ;externe Var?⓪)BNE     IPIMP2        ;dann nicht in Importliste eintragen⓪ IPIMP1   ; Relozierbare Items dürfen nur aus dem Originalmodul importiert wer-⓪); den. Daher wird hier geprüft, ob das Item nicht eine Crossref ist.⓪)BCLR    #15,D5⓪)MOVE    D5,D1⓪)MULU    #6,D1⓪)CMPI.W  #4,0(A3,D1.W) ;CrossRef (importiert)?⓪)BNE     ok⓪)MOVE.L  A0,-(A7)⓪)LEA     0(A3,D1.W),A0⓪ lup      MOVE.L  2(A0),A0⓪)CMPI.W  #4,(A0)⓪)BEQ     lup⓪)ORI.W   #$8000,(A0)   ;(s. ImpXRef)⓪)MOVE.L  (A7)+,A0⓪)BRA     IPIMP3⓪ ok:      MOVE.W  D5,(A4)+      ;ItemNr in Importliste schreiben⓪)MOVE.L  A0,-(A7)⓪)MOVE.L  Header,A0⓪)MOVE.L  A4,D1⓪)SUB.L   A0,D1⓪)SUB.L   14(A0),D1     ;rel. ^Importlisten-Eintrag⓪)MOVE.L  (A7)+,A0⓪)MOVE.L  D1,(A0)       ;  im Baum ueber Adr-Eintrag mogeln⓪)CLR.L   (A4)+         ;hier ^letzte Ref nachtragen (durch FinImp)⓪ IPIMP3:  BSET    #13,D0        ;Import-Flag setzen⓪ IPIMP2:⓪ END⓪ END IPIMP;⓪ ⓪ (* §§§⓪ *   ----------------------------------⓪ *   Item in Importliste fuer Def.Modul eintragen⓪ *      Import-Flag in Kennung (D0) setzen⓪ *   ----------------------------------⓪ *⓪ *      D0 = Kennung⓪ *      D5 = ItemNr⓪ *      D6 = neue IdBaum-Adr⓪ *      A4 = ^wachsende ImportListe⓪ *      CurrentDef = Anfangsadresse des bearbeiteten DefMod⓪ *)⓪ PROCEDURE DefImp;⓪ BEGIN⓪ ASSEMBLER⓪)BSET    #13,D0        ;als Import kennzeichnen⓪)BCLR    #15,D5⓪)⓪ (*$ ? Gepard:⓪(MOVE.W  D5,(A4)+      ;bearbeitete ItemNr⓪(MOVE.L  D6,(A4)+      ;Neubild (später eigene ItemNr)⓪ *)⓪ ⓪ (*$ ? Atari:⓪)⓪); suche, ob Item schon im Ursprungsmodul importiert war⓪)⓪)MOVEM.L D0/D1/A0,-(A7)⓪)MOVE.L  CurrentDef,A0⓪)TST.L   14(A0)         ;Offset zur Importliste im geladenen DefMod⓪)BEQ.W   notfnd         ; keine Importe⓪)ADDA.L  14(A0),A0⓪)BRA     look⓪ look2    LEA     2(A0,D1.W),A0  ;A0 hinter Endmarke der vorigen Importliste⓪ look     TST.L   (A0)           ;noch ein Import?⓪)BEQ.W   notfnd         ; noe⓪)CLR.W   D1⓪)ADDQ    #2,D1          ;Key, Anzahl Items weg⓪ look1    ADDQ    #4,D1          ;beide ItemNr weg⓪)TST.W   0(A0,D1.W)⓪)BEQ     look2          ;Endmarke⓪)CMP.W   2(A0,D1.W),D5  ;dessen eigene Nummer = bearbeitete?⓪)BNE     look1          ; ja⓪)⓪); ja, Originalursprung eintragen⓪)⓪ found    MOVE.L  (A0),D0⓪)CMP.L   CurrentKey,D0 ;gleiches Modul wie zuvor?⓪)BEQ     same⓪)MOVE.L  D0,CurrentKey⓪)CLR.W   (A4)+         ; nein, Endmarke⓪)MOVE.L  D0,(A4)+      ;neuen Key kopieren⓪)MOVE.W  4(A0),(A4)+   ;Anzahl Items kopieren⓪)BSR     copymodname⓪ same     MOVE.W  0(A0,D1.W),(A4)+   ;fremde Nummer kopieren⓪)BRA     ok⓪ ⓪ copymodname:                   ;Modulname ggf. aus impliziter Importliste holen⓪)MOVE.L  A0,-(A7)⓪)MOVE.L  CurrentDef,A0⓪)CMPI.B  #6,(A0)       ;Dlayout⓪)BCS     endloop⓪)ADDA.L  30(A0),A0⓪ loopimp  TST.L   (A0)⓪)BEQ     endloop⓪)CMP.L   (A0)+,D0      ;Key: gesuchtes Modul?⓪)BEQ     foundimp⓪ nextimp  MOVE    (A0)+,D0      ;weiter zum nächsten Key⓪)CMPI.B  #$FE,D0⓪)BCS     nextimp⓪)BRA     loopimp⓪ endloop  CLR.W   (A4)+         ;Flag: kein Modulname bekannt⓪)MOVE.L  (A7)+,A0⓪)RTS⓪ ⓪ foundimp MOVE.W  #1,(A4)+      ;Flag: Modulname ist bekannt⓪ nextcop  MOVE    (A0)+,D0⓪)MOVE    D0,(A4)+⓪)CMPI.B  #$FE,D0⓪)BCS     nextcop⓪)MOVE.L  (A7)+,A0⓪)RTS⓪ ⓪); nein, geladenes DefMod ist Ursprung⓪)⓪ notfnd   MOVE.L  CurrentDef,A0⓪)MOVE.L  4(A0),D0      ;Key⓪)CMP.L   CurrentKey,D0 ;gleiches Modul wie zuvor?⓪)BEQ     same1⓪)MOVE.L  D0,CurrentKey⓪)CLR.W   (A4)+         ; nein, Endmarke⓪)MOVE.L  D0,(A4)+      ;neuen Key kopieren⓪)MOVE.W  12(A0),(A4)+  ;Anzahl Items⓪)BSR     copymodname⓪ same1    MOVE.W  D5,(A4)+      ;bearbeitete ItemNr⓪ ⓪ ok       MOVEM.L (A7)+,D0/D1/A0⓪)MOVE.L  D6,(A4)+      ;Neubild: erlaubt spaeter Feststellung⓪?; der eigenen ItemNr⓪ *)⓪ END⓪ END DefImp;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Itemeintrag im PlaTree scannen;⓪ *      wenn ^named ID (Enum-Element) vorhanden,⓪ *      Nachtrag des Namens ueber ItemAdr anmelden.⓪ *⓪ *   Sollte nur fuer EnumType/EnumElement aufgerufen werden,⓪ *      wenn nachtraeglich ein Import mit Namen gefordert wird.⓪ *      (Kann nicht mit lok. Baeumen und Const-Eintragungen umgehen!)⓪ *   ----------------------------------⓪ *⓪ * TT 01.10.90: Ging schief, wenn zuerst ein Modul mit Enums qual. importiert,⓪ *     dann nochmal der EnumTyp unqual. importiert wird: Adr. und Name der⓪ *     Enum-Elems sind im Neubild schon als bekannt gekennzeichnet, obwohl ihr⓪ *     Name, wie der vom EnumTyp, nochmal im globalen Tree m. Relay angelegt⓪ *     werden müßte. Deshalb wird hier nun, wenn der Name schon bei ItemAdr⓪ *     bekannt, trotzdem der Name nochmal angefordert - ggf. tritt dann eine⓪ *     Namenskollision auf, die aber auch immer ein echter Fehler sein dürfte.⓪ *     Bei kompletten Modulimporten dürfen die IDs natürlich nicht unbedingt⓪ *     angelegt werden, weil die Items sowieso alle drankommen. Die Steuerung⓪ *     dafür übernimmt "anonFlag".⓪ *⓪ *      (D0-D7,A0)⓪ *⓪ *      A0 = ^PlaTree, auf ItemNr⓪ *      A3 = ^Neubildliste⓪ *⓪ *      A0 := ^PlaTree, hinter kopiertes Item⓪ *)⓪ ⓪ PROCEDURE ScanItm;⓪ BEGIN ASSEMBLER⓪*MOVE.W  (A0)+,D0      ;Kennung⓪*MOVE.L  A2,-(A7)⓪*⓪*; passende Eintrags-Beschreibung suchen⓪*⓪*LEA     ITEMS,A2      ;Liste der Item-Beschreibungen⓪ ScanItm8  CMP.B   (A2)+,D0⓪*BEQ     ScanItm6       ;-> Item gefunden⓪ ScanItm7  TST.B   (A2)+         ;falsch, Beschreibung ueberspringen⓪*BNE     ScanItm7⓪*TST.B   (A2)          ;Liste zuende?⓪*BNE     ScanItm8       ;  nein, weiter⓪ ScanErr   MOVE.L  (A7)+,A2⓪*MOVE    #rImpor,D5    ;  ja, merkwuerdig (kann nicht vorkommen!)⓪*JMP     SyntaxErr⓪*⓪*; Eintrag durchsehen⓪*⓪ skipL     ADDQ.L  #2,A0⓪ skipW     ADDQ.L  #2,A0⓪ ScanItm6  MOVE.B  (A2)+,D1      ;* Beschreibung kopieren *⓪*BEQ     ScanItm12     ;Ende dieses Eintrags⓪*CMPI.B  #1,D1⓪*BEQ     SkipW         ;Const.W⓪*CMPI.B  #2,D1⓪*BEQ     SkipL         ;Const.L⓪*CMPI.B  #3,D1⓪*BEQ     SkipW         ;Pointer⓪*⓪*CMPI.B  #5,D1         ;^Identifier (ID muss mit imp. werden)⓪*BEQ     enumTyp⓪*⓪*CMPI.B  #8,D1         ;^Identifier (ID muss mit imp. werden)⓪*BNE     ScanErr       ;falsche Komponente im Eintrag⓪*MOVE.W  (A0)+,D1⓪*MOVE.W  anonFlag,D3   ;Flag, ob der Name unbedingt zu holen ist⓪*TST.W   explicitImport ;wird das Elem mit FROM importiert?⓪*BEQ     ImpItm223⓪*MOVEQ   #2,D3         ;dann Rest anonym nachfordern⓪ ImpItm223 CLR.L   D6            ;keine Linked List bei Vorw.eintraegen⓪*JSR     ItemAdr⓪*BRA     ScanItm6⓪ ⓪ enumTyp   MOVE.W  (A0)+,D1⓪*MOVE.W  anonFlag,D3   ;Flag, ob der Name unbedingt zu holen ist⓪*CLR.L   D6            ;keine Linked List bei Vorw.eintraegen⓪*JSR     ItemAdr⓪*BRA     ScanItm6⓪ ScanItm12 MOVE.L  (A7)+,A2⓪ END⓪ END ScanItm;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Ein Item in Baum eintragen;⓪ *      prueft, ob Eintrag schon da⓪ *   ----------------------------------⓪ *⓪ *      (D0-D7,A0)⓪ *⓪ *      A0 = ^PlaTree, auf ItemNr⓪ *      A3 = ^Neubildliste⓪ *⓪ *      A0 := ^PlaTree, hinter kopiertes Item⓪ *)⓪ ⓪ PROCEDURE ImpItm;⓪ BEGIN⓪ ASSEMBLER⓪)BTST    #7,(A0)       ;exportiert?⓪)BEQ     L1⓪)JMP     ImpItm1⓪ !L1      ADDQ.L  #2,A0⓪)ADDA.W  (A0),A0⓪ END⓪ END ImpItm;⓪ ⓪ PROCEDURE ImpItm1;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.W  (A0)+,D5      ;ItemNr⓪)BCLR    #15,D5        ;Export-Flag weg⓪)JMP     ImpItm20⓪ END⓪ END ImpItm1;⓪ ⓪ (*⓪#Item aus Def-Modul importieren - entscheidet, ob nur Relay⓪#angelegt oder es ganz in den Tree kopiert wird.⓪ *)⓪ PROCEDURE ImpItm20;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.L  A0,-(A7)      ;=== Einsprung von FromImp, ImpRest⓪)ADDQ.L  #2,A0⓪)CMPI.B  #$FE,(A0)⓪)BCC     ImpItm2       ;>= $FE -> kein Id, sondern Endmarke⓪)TST.W   PERVIMP       ;* ID in Baum eintragen *⓪)BEQ     ImpItm17⓪)JSR     SETPER        ; pervasive⓪)BRA     ImpItm3⓪ ImpItm17 JSR     SETID         ; normal⓪ ImpItm3  MOVE.W  A0,D0         ;Sync A0 hinter Namen⓪)BTST    #0,D0⓪)BEQ     ImpItm18⓪)ADDQ.L  #1,A0⓪ ImpItm18 MOVE.L  TRESPC,D6⓪)MOVEQ   #6,D1         ;wir wollen einen Eintrag mit Namen anlegen⓪)JSR     ListImp       ;Item bereits eingetragen?⓪)BEQ     ImpItm4       ; nein, neu eintragen⓪)CLR.B   -1(A1,D6.L)   ; ja, Relay anlegen: Kennung ist 0.B,⓪)TST.B   -1(A1,D1.L)   ;ist Item selbst ein Relay?⓪)BNE     noRelay⓪)MOVE.L  -6(A1,D1.L),D1 ;dann Verweis verwenden⓪ noRelay  MOVE.B  -2(A1,D1.L),-2(A1,D6.L) ; Flags kopieren!⓪)MOVE.L  D1,-6(A1,D6.L)⓪)SUBQ.L  #6,D6⓪)MOVE.L  D6,TRESPC⓪)MOVE.B  -1(A1,D1.L),D1 ;Kennung des Objekts⓪)CMP.B   #09,D1        ;Enumtyp ?⓪)BEQ     Scan⓪)CMP.B   #10,D1        ;Enum-Element ?⓪)BNE     ImpItm5⓪ Scan     ADDQ.L  #4,A7⓪)JMP     ScanItm       ;Namenseintrag fuer EnumElement nachfordern⓪ ImpItm2  MOVE.W  #2,anonFlag⓪)ADDQ.L  #2,A0         ;Dummy-Name weg⓪)MOVE.L  TRESPC,D6     ;* Item anonym eintragen *⓪)MOVEQ   #1,D1         ;geplant ist anonymer Eintrag⓪)JSR     ListImp       ;schon eingetragen?⓪)BEQ     ImpItm4       ; nein, eintragen⓪ ImpItm5  MOVE.L  (A7)+,A0      ; ja, Rest des Eintrags im PlaTree ueberspringen⓪)ADDA.W  (A0),A0⓪)RTS⓪ ImpItm4  ADDQ.L  #4,A7         ;* Item muss wirklich kopiert werden *⓪)JMP     ImpItm30⓪ END⓪ END ImpItm20;⓪ ⓪ (*⓪#Importiertes Item in Importliste eintragen⓪ *)⓪ PROCEDURE ImpItm30;⓪ BEGIN⓪ ASSEMBLER⓪); === Einsprung von ImpRest⓪)MOVE.W  (A0)+,D0      ;Kennung⓪)CMPI.W  #3,IPFLAG     ;DefMod?⓪)BEQ     ImpItm15⓪)JSR     IPIMP         ; nein, ImpListe fuer Imp/PgmMod⓪)JMP     ImpItm16⓪ ImpItm15 JSR     DefImp        ; ja, ImpListe fuer DefMod⓪)JMP     ImpItm16⓪ END⓪ END ImpItm30;⓪ ⓪ (*⓪#Item aus Def-Modul in Baum eintragen⓪ *)⓪ PROCEDURE ImpItm16;⓪ BEGIN⓪ ASSEMBLER⓪*JSR     SETKNG        ;=== Einsprung von OwnDef⓪*MOVE.L  D6,-(A7)⓪*SUBQ.L  #2,D6⓪*MOVE.L  A2,-(A7)⓪*CMPI.B  #31,D0        ;StrConst?⓪*BNE     ImpItm23⓪ ⓪*; Sonderbehandlung String-Const⓪*MOVE.B  (A0),D1       ;  ja, Laenge holen⓪*BSET    #0,D1         ;  auf gerade Byte-Zahl aufrunden⓪ !ImpItm24 SUBQ.L  #1,D6        ;  und String kopieren⓪*MOVE.B  (A0)+,0(A1,D6.L)⓪*DBF     D1,ImpItm24⓪*BRA.L   ImpItm12⓪ ⓪ !ImpItm23 LEA     ITEMS,A2      ;Liste der Item-Beschreibungen⓪ !ImpItm8  CMP.B   (A2)+,D0⓪*BEQ     ImpItm6       ;-> Item gefunden⓪ !ImpItm7  TST.B   (A2)+         ;falsch, Beschreibung ueberspringen⓪*BNE     ImpItm7⓪*TST.B   (A2)          ;Liste zuende?⓪*BNE     ImpItm8       ;  nein, weiter⓪*MOVE.L  (A7)+,A2⓪*MOVE    #rImpor,D5    ;  ja, merkwuerdiges Item⓪*JMP     SyntaxErr⓪ ⓪ !ImpItm6  MOVE.B  (A2)+,D1      ;* Beschreibung kopieren *⓪*BEQ.L   ImpItm12      ;Ende dieses Eintrags⓪*⓪*CMPI.B  #1,D1⓪*BNE     ImpItm9⓪*MOVE.W  (A0)+,D1      ;^anderes Item, anonym⓪*SUBQ.L  #4,D6⓪*MOVEQ   #2,D3         ;Flag 'anonym'⓪*JSR     ItemAdr       ;Adresse bzw. Pointerkette⓪*MOVE.L  D0,0(A1,D6.L)⓪*BRA     ImpItm6⓪ ⓪ !ImpItm9  CMPI.B  #2,D1⓪*BNE     ImpItm10⓪*SUBQ.L  #4,D6         ;Const.L⓪*MOVE.L  (A0)+,0(A1,D6.L)⓪*BRA     ImpItm6⓪ ⓪ !ImpItm10 CMPI.B  #3,D1⓪*BNE     ImpItm11⓪*SUBQ.L  #2,D6         ;Const.W⓪*MOVE.W  (A0)+,0(A1,D6.L)⓪*BRA     ImpItm6⓪ ⓪ !ImpItm11 CMPI.B  #4,D1⓪*BNE     ImpItm22⓪*SUBQ.L  #4,D6         ;Record: lokaler Baum⓪*MOVE.L  D6,TRESPC⓪*MOVE.L  D6,-(A7)      ;hier ^lok.Baum nachtragen⓪*CLR.L   -(A6)⓪ !ImpItm14 TST.W   (A0)          ;Ende des lok. Baums?⓪*BEQ     ImpItm25⓪*MOVE.W  anonFlag,-(A7)⓪*JSR     ImpItm1       ;  nein, weiter⓪*MOVE.W  (A7)+,anonFlag⓪*BRA     ImpItm14⓪ !ImpItm25 ADDQ.L  #2,A0         ;  ja, Endmarke ueberspringen⓪*MOVE.L  (A7)+,D1⓪*MOVE.L  (A6)+,0(A1,D1.L) ;^lokalen Baum nachtragen⓪*BRA.W   ImpItm13⓪ ⓪ !ImpItm22 CMPI.B  #5,D1⓪*BNE     ImpItm222⓪*SUBQ.L  #4,D6         ;^Enum-Elem von Enum-Typ⓪*MOVE.W  (A0)+,D1⓪*MOVE.W  anonFlag,D3   ;anonym nur, wenn laufendes Item selbst anon.⓪*JSR     ItemAdr⓪*MOVE.L  D0,0(A1,D6.L)⓪*BRA     ImpItm6⓪*⓪ ImpItm222 CMPI.B  #8,D1⓪*BNE     ImpItm26⓪*SUBQ.L  #4,D6         ;^Enum-Elem von Enum-Elem⓪*MOVE.W  (A0)+,D1⓪*MOVE.W  anonFlag,D3   ;anonym nur, wenn laufendes Item selbst anon.⓪*TST.W   explicitImport ;wird das Elem mit FROM importiert?⓪*BEQ     ImpItm223⓪*MOVEQ   #2,D3         ;dann Rest anonym nachfordern⓪ ImpItm223 JSR     ItemAdr⓪*MOVE.L  D0,0(A1,D6.L)⓪*BRA     ImpItm6⓪ ⓪ ImpItm26  CMPI.B  #7,D1         ;Insert <n> Bytes-Anweisung?⓪*BNE     ImpItm28⓪*MOVEQ   #0,D1⓪*MOVE.B  (A2)+,D1      ;hole Anzahl Bytes⓪*BRA     ImpItm26b⓪ ImpItm26a SUBQ.L  #1,D6         ;Const.W⓪*CLR.B   0(A1,D6.L)⓪ ImpItm26b DBRA    D1,ImpItm26a  ;im Baum reservieren & löschen⓪*BRA     ImpItm6⓪*⓪ !ImpItm28 SUBQ.L  #2,D6         ;Laengenangabe fuer folgende Const⓪*MOVE.W  (A0)+,D0⓪*MOVE.W  D0,0(A1,D6.L)⓪ !ImpItm27 MOVE.L  (A0)+,-4(A1,D6.L) ;Const kopieren⓪*SUBQ.L  #4,D6⓪*SUBQ.W  #4,D0⓪*BGT     ImpItm27⓪*BRA     ImpItm6⓪ ⓪ !ImpItm12 MOVE.L  D6,TRESPC⓪ !ImpItm13 MOVE.L  (A7)+,A2⓪ ⓪*; bei Real-Consts ggf. Format anpassen⓪*MOVE.L  (A7)+,D0⓪*TST     mustChgFormat   ;bleibt Format unverändert?⓪*BEQ     ImpItm29⓪*CMPI.B  #18,-1(A1,D0.L) ;Const?⓪*BEQ     ImpItm31⓪*CMPI.B  #50,-1(A1,D0.L) ;Const?⓪*BNE     ImpItm29⓪*MOVE.L  -10(A1,D0.L),D1  ;Typ^ holen⓪*BRA     ImpItm32⓪ ImpItm31: MOVE.L  -6(A1,D0.L),D1  ;Typ^ holen⓪ ImpItm32: CMP.L   RealPtr,D1⓪*BEQ     lReal⓪*CMP.L   SRealPtr,D1⓪*BNE     ImpItm29⓪*; ShortReal anpassen⓪*MOVEM.L D2/A0-A3,-(A7)⓪*; *** zeitweilige Restriktion: Keine Formatanpassung bei ShortReals!⓪*MOVE    #rRealF,D5⓪*JMP     SyntaxErr⓪*BRA     ImpItm21⓪ lReal     ; LongReal anpassen⓪*MOVEM.L D2/A0-A3,-(A7)⓪*MOVE.L  EvalStk,A3⓪*LEA     -8(A1,D0.L),A0⓪*CMPI.B  #50,-1(A1,D0.L) ;Const neu?⓪*BNE     ImpItm33⓪*SUBQ.L  #8,A0⓪ ImpItm33: MOVE.L  -(A0),(A3)+⓪*MOVE.L  -(A0),(A3)+⓪*MOVE.L  A0,-(A7)⓪*MOVE    defFormat,D0⓪*MOVE    D0,(A3)+        ;Format im Def-Mod⓪*EORI    #1,D0⓪*MOVE    D0,(A3)+        ;Zielformat⓪*JSR     Conv⓪*MOVE.L  (A7)+,A0⓪*MOVE.L  -(A3),(A0)+⓪*MOVE.L  -(A3),(A0)+⓪ !ImpItm21 MOVEM.L (A7)+,D2/A0-A3⓪*JSR     RealConstIsUsed  ;Real-Format ist nun festgelegt⓪ !ImpItm29⓪ END⓪ END ImpItm16;⓪ ⓪ (*⓪ PROCEDURE ConvRealToDestFormat;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L  A3,-(A7)⓪(MOVE.L  EvalStk,A3⓪(MOVE    UseFormat,D0⓪(CMPI    #3,D0⓪(BEQ     noRconv        ;hat schon richtiges Format⓪(! wenn Werte = 2, dann 1 daraus machen!⓪(MOVE    SysFormat,(A3)+ ;Format der Zahl⓪(MOVE    D0,(A3)+        ;gewünschtes Format⓪(JSR     Conv⓪&noRconv⓪(MOVE.L  -(A3),AccuS14⓪(MOVE.L  -(A3),Accu⓪(MOVE.L  A3,EvalStk⓪(MOVE.L  (A7)+,A3⓪$END⓪"END ConvRealToDestFormat;⓪ ⓪ PROCEDURE ConvRealToSysFormat;⓪"(* A0: Ptr auf Real-Const *)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L  A3,-(A7)⓪(MOVE.L  EvalStk,A3⓪(MOVE    UseFormat,D0⓪(CMPI    #3,D0⓪(BEQ     noRconv        ;hat schon richtiges Format⓪(! wenn Werte = 2, dann 1 daraus machen!⓪(MOVE    SysFormat,(A3)+ ;Format der Zahl⓪(MOVE    D0,(A3)+        ;gewünschtes Format⓪(JSR     Conv⓪&noRconv⓪(MOVE.L  -(A3),AccuS14⓪(MOVE.L  -(A3),Accu⓪(MOVE.L  A3,EvalStk⓪(MOVE.L  (A7)+,A3⓪$END⓪"END ConvRealToSysFormat;⓪ *)⓪ ⓪ (*⓪ *   ----------------------------------⓪ *   Item aus eigenem DefModul importieren:⓪ *      aus PlaTree kopieren,⓪ *      exportierte Proc/Var in ExportListe eintragen⓪ *   ----------------------------------⓪ *⓪ *      (D0,D5,D6,A4)⓪ *⓪ *      A0 = ^Item im PlaTree⓪ *      A4 = laufender ^ auf entstehende ExportListe⓪ *)⓪ PROCEDURE OwnItm;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.W  (A0)+,D5      ;ItemNr⓪)MOVE.L  A0,-(A7)⓪)ADDQ.L  #2,A0⓪)CMPI.B  #$FE,(A0)⓪)BCC     OwnItm2       ;>= $FE -> kein Id, sondern Endmarke⓪)⓪)JSR     SETID         ;ID eintragen⓪)MOVE.W  A0,D0⓪)BTST    #0,D0         ;Sync A0⓪)BEQ     OwnItm3⓪)ADDQ.L  #1,A0⓪ !OwnItm3 MOVE.W  #2,anonFlag   ;2: die IDs kommen ja sowieso irgendwann vor...⓪)MOVE.L  TRESPC,D6⓪)MOVEQ   #6,D1         ;wir wollen einen Eintrag mit Namen anlegen⓪)JSR     ListImp       ;Item anonym schon da?⓪)BEQ     OwnItm4       ;nein, neu eintragen⓪)CLR.B   -1(A1,D6.L)   ; ja, Relay anlegen: Kennung und..⓪)TST.B   -1(A1,D1.L)   ;ist Item selbst ein Relay?⓪)BNE     noRelay⓪)MOVE.L  -6(A1,D1.L),D1 ;dann Verweis verwenden⓪ noRelay  MOVE.B  -2(A1,D1.L),-2(A1,D6.L) ; Flags kopieren⓪)MOVE.L  D1,-6(A1,D6.L)⓪)SUBQ.L  #6,D6⓪)MOVE.L  D6,TRESPC⓪)CMPI.B  #25,-1(A1,D1.L) ;Opaque?⓪)BNE     OwnItm5⓪)MOVE.B  #8,-1(A1,D1.L)  ;redeclarable machen (jm 1404)⓪ !OwnItm5 MOVE.L  (A7)+,A0⓪)ADDA.W  (A0),A0⓪)RTS                   ;PlaTree-Eintrag ueberspringen⓪ ⓪ !OwnItm2 MOVE.L  TRESPC,D6     ;*** anonymes Item eintragen:⓪)MOVE.W  #2,anonFlag⓪)ADDQ.L  #2,A0         ;Blind-ID weg⓪)MOVEQ   #1,D1         ;geplant ist anonymer Eintrag⓪)JSR     ListImp⓪)BNE     OwnItm5       ;gibt's schon: nichts zu tun⓪ !OwnItm4 ADDQ.L  #4,A7⓪)MOVE.W  (A0)+,D0      ;Kennung⓪)BCLR    #15,D5        ;Export?⓪)BEQ     OwnItm7       ;nein⓪)CMPI.B  #50,D0        ;Const?⓪)BEQ     OwnItm8⓪)CMPI.B  #17,D0        ;Var?⓪)BEQ     OwnItm8⓪)CMPI.B  #6,D0         ;Proc?⓪)BNE     OwnItm7⓪ OwnItm6  BSET    #12,D0        ;Proc zus. markieren (falls Implement. fehlt,⓪?; soll das von FORWARD-Dekl. unterscheidbar sein⓪ OwnItm8  MOVE.W  D5,(A4)+      ;ItemNr der Var/Proc in Exp.Liste eintragen⓪)MOVE.L  D6,(A4)+      ;  hier Adr nachtragen⓪ OwnItm7  CMPI.B  #50,D0        ;Const?⓪)BEQ     L1⓪)CMPI.B  #25,D0        ;Opaque?⓪)BNE     L0⓪)MOVE.B  #8,D0         ;redeclarable machen⓪)BRA     L0⓪ L1:      BSET    #12,D0        ;Flag setzen, um zu erkennen, daß eigene⓪?; CONST auch außerhalb des Moduls evtl. benutzt⓪?; wird, damit sie dann nicht wegoptimiert wird.⓪ L0:      JMP     ImpItm16⓪ END⓪ END OwnItm;⓪)⓪ (*⓪ *   ----------------------------------⓪ *   Eigenes Def.Modul in Impl.Modul laden:⓪ *      PlaTree uebernehmen, Exportliste anlegen⓪ *   ----------------------------------⓪ *⓪ *      (D0,D3,A3,A4)⓪ *⓪ *      A4 = Beginn der anzulegenden Exportliste⓪ *⓪ *      A0 := ^eigenes DefModul⓪ *      VarSpc := Platzbedarf der im DefMod deklarierten Variablen⓪ *)⓪ PROCEDURE OwnDef;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.W  D3,-(A7)⓪)MOVE.W  OLDSBL,-(A7)⓪)CLR.W   PERVIMP       ;wird beim Import von Records abgefragt!⓪)JSR     SetDef⓪)BEQ     OK⓪)MOVE    #rMyDef,D5        ;nicht gefunden⓪)JMP     SyntaxErr⓪ !OK      MOVE.L  A0,-(A7)⓪)MOVE.L  A4,D0⓪)MOVE.L  Header,A0⓪)SUB.L   A0,D0⓪)MOVE.L  D0,18(A0)    ;^Exp.Liste⓪)MOVE.L  (A7),A0      ;wieder ^eigenes DefMod⓪)MOVE.L  8(A0),D0     ;Offset bis PlatTree⓪)BEQ     OwnDef1      ;keiner da⓪)ADDA.L  D0,A0⓪ !OwnDef2 TST.W   (A0)          ;Liste zuende?⓪)BEQ     OwnDef1⓪)JSR     OwnItm        ;A0=^ItemNr⓪)BRA     OwnDef2⓪ !OwnDef1 CLR.W   (A4)+         ;Endmarke Exp.Liste⓪)MOVE.L  (A7)+,A0⓪)MOVE.L  Header,A3⓪)MOVE.L  4(A0),2(A3)   ;Key fuer I.Mod uebernehmen⓪)MOVE.L  18(A0),VARSPC ;Platz der vergebenen Var.⓪)MOVE.W  (A7)+,OLDSBL⓪)MOVE.W  (A7)+,D3⓪ END⓪ END OwnDef;⓪ ⓪ ⓪ CONST    PseudoLen = 78;          (* Anzahl def. Items *)⓪)SystemLen = 38;          (* Anzahl def. Items *)⓪ ⓪ (*⓪!*   ----------------------------------⓪!*    Pseudo-Modul mit StandardTypen und -Prozeduren⓪!*   ----------------------------------⓪!*    Pseudo- und Systemmodul muessen in dieser Reihenfolge hintereinander⓪!*    stehen, damit in Neubild die Platzpruefung funktioniert!⓪!*)⓪ ⓪ PROCEDURE Pseudo;⓪ BEGIN⓪ ASSEMBLER⓪ Pseudo0  DC.B    6,3            ;Dlayout⓪)DC.W    2              ;pervasive-Flag⓪)DC.L    PseudoKey      ;Key⓪(;DC.L    Pseudo1-Pseudo0 ;^ExportListe⓪)DC.L    62⓪)DC.W    PseudoLen       ;Anzahl def. Items⓪(;DC.L    PseudoI-Pseudo0 ;^ImportListe⓪)DC.L    34⓪)DC.L    0              ;Platz fuer definierte Var.⓪)DC.L    0              ;^Modulname⓪(;DC.W    PseudoI-Pseudo0⓪)DC.W    34             ;Headerlänge⓪)DC.W    0              ;^Sourcename⓪)DC.L    0              ;^Liste d. implizit zu importierenden Module⓪ PseudoI  DC.L    SystemKey      ;Import aus System⓪)DC.W    SystemLen      ;Anzahl Items in System⓪)DC.W    1              ;WORD importieren⓪)DC.W    27             ;eigene ItemNr⓪)DC.W    2              ;ADDRESS importieren⓪)DC.W    48⓪)DC.W    3              ;LONG importieren⓪)DC.W    28⓪)DC.W    4              ;BYTE importieren⓪)DC.W    29⓪)DC.W    0⓪)DC.L    0              ;Ende der Importliste⓪ Pseudo1  DC.W    $8001,16       ;TYPE LongInt⓪)ASC     'LONGINT'⓪)DC.B    $FF⓪)DC.W    $8501⓪)DC.L    4⓪ Pseudo2  DC.W    $8002,18       ;TYPE LongReal⓪)ASC     'LONGREAL'⓪)DC.B    $FE,$FF⓪)DC.W    $8402⓪)DC.L    8⓪ Pseudo3  DC.W    $8003,18       ;TYPE LongCard⓪)ASC     'LONGCARD'⓪)DC.B    $FE,$FF⓪)DC.W    $8516⓪)DC.L    4⓪ Pseudo4  DC.W    $8004,14       ;TYPE Char⓪)ASC     'CHAR'⓪)DC.B    $FE,$FF⓪)DC.W    $8503⓪)DC.L    1⓪ Pseudo5  DC.W    $8005,16       ;TYPE Boolean⓪)ASC     'BOOLEAN'⓪)DC.B    $FF⓪)DC.W    $8518⓪)DC.L    2⓪ Pseudo6  DC.W    $8006,18       ;TYPE SHORTINT⓪)ASC     'SHORTINT'⓪)DC.B    $FE,$FF⓪)DC.W    $8521⓪)DC.L    2⓪ Pseudo7  DC.W    $8007,18       ;TYPE SHORTCARD⓪)ASC     'SHORTCARD'⓪)DC.B    $FF⓪)DC.W    $8522⓪)DC.L    2⓪ Pseudo8  DC.W    $8008,10      ;TYPE ShortBothType⓪)DC.B    $FE,$FF⓪)DC.W    $8523⓪)DC.L    2⓪ Pseudo9  DC.W    $8009,10       ;TYPE LongBothType⓪)DC.B    $FE,$FF⓪)DC.W    $851E⓪)DC.L    4⓪ (*$? NOT BITSETfromSYSTEM:⓪ Pseudo10 DC.W    $800A,18       ;TYPE BitSet⓪)ASC     'BITSET'⓪)DC.B    $FE,$FF⓪)DC.W    $842D          ; nun mit Kennung 45 statt 5! (30.6.90)⓪)DC.L    2⓪)DC.W    72⓪ *)⓪ (*$? BITSETfromSYSTEM:⓪ Pseudo10 DC.W    $000A,6        ;nur dummy⓪)DC.B    $FE,$FF⓪)DC.W    $803F⓪ *)⓪ Pseudo11 DC.W    $800B,18       ;TYPE Proc⓪)ASC     'PROC'⓪)DC.B    $FE,$FF⓪)DC.W    $8413⓪)DC.L    4⓪)DC.W    0,0⓪ Pseudo12 DC.W    $800C,10       ;TYPE ZZ⓪)DC.B    $FE,$FF⓪)DC.W    $8504⓪)DC.L    6⓪ Pseudo13 DC.W    $800D,14       ;TYPE ShortReal⓪)ASC     'REAL'⓪)DC.B    $FE,$FF⓪)DC.W    $8428⓪)DC.L    4⓪ Pseudo14 DC.W    $800E,14       ;TYPE Integer⓪)ASC     'INTEGER'⓪)DC.B    $FF⓪)DC.W    $0000          ; Relay auf SHORTINT⓪)DC.W    6⓪ Pseudo15 DC.W    $800F,16       ;TYPE Cardinal⓪)ASC     'CARDINAL'⓪)DC.B    $FE,$FF⓪)DC.W    $0000          ; Relay auf SHORTCARD⓪)DC.W    7⓪ Pseudo16 DC.W    $8010,6        ;Hilfseintrag f. noch ungelöste Ptr/Proc-Refs⓪)DC.B    $FE,$FF⓪)DC.W    $8000+48⓪ Pseudo17 DC.W    $8011,14       ;TYPE SS⓪)DC.B    $FE,$FF⓪)DC.W    $841B⓪)DC.L    0,0            ;2. Long nur sicherheitshalber wg. Kompat.⓪ Pseudo18 DC.W    $8012,10       ;TYPE >signed byte<⓪)DC.B    $FE,$FF⓪)DC.W    $8527⓪)DC.L    1⓪ Pseudo19 DC.W    $8013,10       ;TYPE >strukt. Konst.<⓪)DC.B    $FE,$FF⓪)DC.W    $842B⓪)DC.L    0⓪ Pseudo20 DC.W    $8014,20       ;CONST MaxInt⓪)ASC     'MaxInt'⓪)DC.B    $FE,$FF⓪)DC.W    $8012,8,2⓪)DC.L    $7FFF⓪ Pseudo21 DC.W    $8015,12       ;Parameter ABS (Integer): Cardinal;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,6,7,22⓪ Pseudo22 DC.W    $8016,12       ;Parameter ABS (LongInt): LongCard;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,1,3,58⓪ Pseudo23 DC.W    $8017,12       ;Procedure ORD⓪)ASC     'ORD'⓪)DC.B    $FF⓪)DC.W    $8024,2,24⓪ Pseudo24 DC.W    $8018,12       ;Parameter ORD (anyThing): Cardinal;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,0,7,00⓪ Pseudo25 DC.W    $8019,14       ;Procedure HIGH⓪)ASC     'HIGH'⓪)DC.B    $FE,$FF⓪)DC.W    $8024,3,26⓪ Pseudo26 DC.W    $801A,12       ;Parameter HIGH (anyThing): Cardinal;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,0,7,00⓪ Pseudo27 DC.W    $001B,10       ;WORD anonym⓪)DC.B    $FE,$FF⓪)DC.W    $8515⓪)DC.L    2⓪ Pseudo28 DC.W    $001C,10       ;LONG anonym⓪)DC.B    $FE,$FF⓪)DC.W    $851A⓪)DC.L    4⓪ Pseudo29 DC.W    $001D,10       ;BYTE anonym⓪)DC.B    $FE,$FF⓪)DC.W    $8526⓪)DC.L    1⓪ Pseudo30 DC.W    $801E,14       ;Procedure LONG⓪)ASC     'LONG'⓪)DC.B    $FE,$FF⓪)DC.W    $8024,4,31⓪ Pseudo31 DC.W    $801F,12       ;Parameter LONG (Cardinal): LONGCARD;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,7,3,32⓪ Pseudo32 DC.W    $8020,12       ;Parameter LONG (Integer): LONGINT;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,6,1,33⓪ Pseudo33 DC.W    $8021,12       ;Parameter LONG (Word): Long;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,27,28,34⓪ Pseudo34 DC.W    $8022,12       ;Parameter LONG (Byte): Word;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,29,27,66⓪ Pseudo35 DC.W    $8023,14       ;Procedure SHORT⓪)ASC     'SHORT'⓪)DC.B    $FF⓪)DC.W    $8024,5,36⓪ Pseudo36 DC.W    $8024,12       ;Parameter SHORT (LongCard): Cardinal;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,3,7,37⓪ Pseudo37 DC.W    $8025,12       ;Parameter SHORT (LongInt): Integer;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,1,6,38⓪ Pseudo38 DC.W    $8026,12       ;Parameter SHORT (Long): Word;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,28,27,39⓪ Pseudo39 DC.W    $8027,12       ;Parameter SHORT (Word): Byte;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,27,29,65⓪ Pseudo40 DC.W    $8028,12       ;Procedure ODD⓪)ASC     'ODD'⓪)DC.B    $FF⓪)DC.W    $8024,6,41⓪ Pseudo41 DC.W    $8029,12       ;Parameter ODD (anyScalar): Boolean;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,0,5,0⓪ Pseudo42 DC.W    $802A,12       ;Procedure INC⓪)ASC     'INC'⓪)DC.B    $FF⓪)DC.W    $8024,20,00⓪ Pseudo43 DC.W    $802B,12       ;Procedure DEC⓪)ASC     'DEC'⓪)DC.B    $FF⓪)DC.W    $8024,21,00⓪ Pseudo44 DC.W    $802C,12       ;Procedure NEW⓪)ASC     'NEW'⓪)DC.B    $FF⓪)DC.W    $8024,22,00⓪ Pseudo45 DC.W    $802D,16       ;Procedure DISPOSE⓪)ASC     'DISPOSE'⓪)DC.B    $FF⓪)DC.W    $8024,23,00⓪ Pseudo46 DC.W    $802E,14       ;Procedure INCL⓪)ASC     'INCL'⓪)DC.B    $FE,$FF⓪)DC.W    $8024,24,00⓪ Pseudo47 DC.W    $802F,14       ;Procedure EXCL⓪)ASC     'EXCL'⓪)DC.B    $FE,$FF⓪)DC.W    $8024,25,00⓪ Pseudo48 DC.W    $0030,12       ;ADDRESS anonym⓪)DC.B    $FE,$FF⓪)DC.W    $8517          ;eigener Code, aber Struktur wie Pointer!⓪)DC.L    4⓪)DC.W    27⓪ Pseudo49 DC.W    $8031,16       ;CONST nil⓪)ASC     'NIL'⓪)DC.B    $FF⓪)DC.W    $8012,48,4⓪)DC.L    0⓪ Pseudo50 DC.W    $8032,18       ;CONST true⓪)ASC     'TRUE'⓪)DC.B    $FE,$FF⓪)DC.W    $8012,5,2⓪)DC.L    1⓪ Pseudo51 DC.W    $8033,18       ;CONST false⓪)ASC     'FALSE'⓪)DC.B    $FF⓪)DC.W    $8012,5,2⓪)DC.L    0⓪ Pseudo52 DC.W    $8034,12       ;Procedure MIN⓪)ASC     'MIN'⓪)DC.B    $FF⓪)DC.W    $8024,7,00⓪ Pseudo53 DC.W    $8035,12       ;Procedure MAX⓪)ASC     'MAX'⓪)DC.B    $FF⓪)DC.W    $8024,8,00⓪ Pseudo54 DC.W    $8036,14       ;Procedure SIZE⓪)ASC     'SIZE'⓪)DC.B    $FE,$FF⓪)DC.W    $8024,11,8⓪ Pseudo55 DC.W    $8037,12       ;Parameter SIZE (anyThing): LongCard⓪)DC.B    $FE,$FF⓪)DC.W    $8025,0,3,0⓪ Pseudo56 DC.W    $8038,12       ;Procedure VAL⓪)ASC     'VAL'⓪)DC.B    $FF⓪)DC.W    $8024,9,0      ;keine Parameter/Result-Beschreibung!⓪ Pseudo57 DC.W    $8039,16       ;Procedure LENGTH⓪)ASC     'LENGTH'⓪)DC.B    $FE,$FF⓪)DC.W    $8024,10,0     ;keine Parameter/Result-Beschreibung!⓪ Pseudo58 DC.W    $803A,12       ;Parameter ABS (Real): Real;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,2,2,0⓪ Pseudo59 DC.W    $803B,12       ;Procedure INT⓪)ASC     'INT'⓪)DC.B    $FF⓪)DC.W    $8024,12,0     ;keine Parameter/Result-Beschreibung!⓪ Pseudo60 DC.W    $803C,12       ;Procedure CAP⓪)ASC     'CAP'⓪)DC.B    $FF⓪)DC.W    $8024,13,0     ;keine Parameter/Result-Beschreibung!⓪ Pseudo61 DC.W    $803D,12       ;Procedure CHR⓪)ASC     'CHR'⓪)DC.B    $FF⓪)DC.W    $8024,14,0     ;keine Parameter/Result-Beschreibung!⓪ Pseudo62 DC.W    $803E,14       ;Procedure FLOAT⓪)ASC     'FLOAT'⓪)DC.B    $FF⓪)DC.W    $8024,15,0     ;keine Parameter/Result-Beschreibung!⓪ Pseudo63 DC.W    $803F,16       ;Procedure LFLOAT⓪)ASC     'LFLOAT'⓪)DC.B    $FE,$FF⓪)DC.W    $8024,16,0     ;keine Parameter/Result-Beschreibung!⓪ Pseudo64 DC.W    $8040,14       ;Procedure TRUNC⓪)ASC     'TRUNC'⓪)DC.B    $FF⓪)DC.W    $8024,17,0     ;keine Parameter/Result-Beschreibung!⓪ Pseudo65 DC.W    $8041,12       ;Parameter SHORT (LONGREAL): REAL;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,2,13,69⓪ Pseudo66 DC.W    $8042,12       ;Parameter LONG (REAL): LONGREAL;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,13,2,68⓪ Pseudo67 DC.W    $8043,12       ;Parameter SHORT (INTEGER): Byte;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,6,29,71⓪ Pseudo68 DC.W    $8044,12       ;Parameter LONG (SBothTyp): BothTyp;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,8,9,0⓪ Pseudo69 DC.W    $8045,12       ;Parameter SHORT (BothTyp): SBothTyp;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,9,8,70⓪ Pseudo70 DC.W    $8046,12       ;Parameter SHORT (SBothTyp): Byte;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,9,29,67⓪ Pseudo71 DC.W    $8047,12       ;Parameter SHORT (CARDINAL): Byte;⓪)DC.B    $FE,$FF⓪)DC.W    $8025,7,29,0⓪ (*$? NOT BITSETfromSYSTEM:⓪ Pseudo72 DC.W    $8048,20       ;Subrange CARDINAL[0..15] f. BITSET⓪)DC.B    $FE,$FF⓪)DC.W    $850B⓪)DC.L    2,0,15         ;Size=2, Low=0, Hi=15⓪)DC.W    7              ;Base Type: CARDINAL⓪ *)⓪ (*$? BITSETfromSYSTEM:⓪ Pseudo72 DC.W    $0048,6        ;nur dummy⓪)DC.B    $FE,$FF⓪)DC.W    $803F⓪ *)⓪ Pseudo73 DC.W    $8049,20       ;CONST MinInt⓪)ASC     'MinInt'⓪)DC.B    $FE,$FF⓪)DC.W    $8012,6,2⓪)DC.L    $FFFF8000⓪ Pseudo74 DC.W    $804A,20       ;CONST MaxCard⓪)ASC     'MaxCard'⓪)DC.B    $FF⓪)DC.W    $8012,7,2⓪)DC.L    $FFFF⓪ Pseudo75 DC.W    $804B,20       ;CONST MaxLInt⓪)ASC     'MaxLInt'⓪)DC.B    $FF⓪)DC.W    $8012,9,4⓪)DC.L    $7FFFFFFF⓪ Pseudo76 DC.W    $804C,20       ;CONST MinLInt⓪)ASC     'MinLInt'⓪)DC.B    $FF⓪)DC.W    $8012,1,4⓪)DC.L    $80000000⓪ Pseudo77 DC.W    $804D,22       ;CONST MaxLCard⓪)ASC     'MaxLCard'⓪)DC.B    $FE,$FF⓪)DC.W    $8012,3,4⓪)DC.L    $FFFFFFFF⓪ Pseudo78 DC.W    $804E,12       ;Procedure ABS⓪)ASC     'ABS'⓪)DC.B    $FF⓪)DC.W    $8024,1,21⓪)⓪)DC.W    0⓪ END⓪ END Pseudo;⓪ ⓪ (*⓪ *   ----------------------------------⓪ *    System-Modul mit StandardTypen und -Prozeduren⓪ *   ----------------------------------⓪ *)⓪ PROCEDURE SysMod;⓪ BEGIN⓪ ASSEMBLER⓪ ⓪ System0  DC.B    6,3            ;Dlayout⓪)DC.W    1              ;Qualified-Flag (NICHT pervasive!)⓪)DC.L    SystemKey      ;Key⓪(;DC.L    System1-System0 ;^ExportListe⓪)DC.L    58⓪)DC.W    SystemLen       ;Anzahl def. Items⓪(;DC.L    SystemI-System0 ;^ImportListe⓪)DC.L    34⓪)DC.L    0              ;Platz fuer definierte Var.⓪)DC.L    0              ;^Modulname⓪(;DC.W    SystemI-System0⓪)DC.W    34             ;Headerlänge⓪)DC.W    0              ;^Sourcename⓪)DC.L    0              ;^Liste d. implizit zu importierenden Module⓪ SystemI  DC.L    PseudoKey      ;Import aus Pseudo⓪)DC.W    PseudoLen      ;Anzahl Items in Pseudo⓪)DC.W    3              ;LongCard importieren⓪)DC.W    10             ;eigene ItemNr⓪)DC.W    11             ;PROC importieren⓪)DC.W    15             ;eigene ItemNr⓪)DC.W    8              ;ShortBothTyp importieren⓪)DC.W    24             ;eigene ItemNr⓪)DC.W    0⓪)DC.L    0              ;Ende der Importliste⓪ System1  DC.W    $8001,14       ;TYPE Word⓪)ASC     'WORD'⓪)DC.B    $FE,$FF⓪)DC.W    $8515⓪)DC.L    2⓪ System2  DC.W    $8002,18       ;TYPE Address⓪)ASC     'ADDRESS'⓪)DC.B    $FF⓪)DC.W    $8517          ;eigener Code, aber Struktur wie Pointer!⓪)DC.L    4⓪)DC.W    1              ;Pointer to Word⓪ System3  DC.W    $8003,18       ;TYPE LongWord⓪)ASC     'LONGWORD'⓪)DC.B    $FE,$FF⓪)DC.W    $851A⓪)DC.L    4⓪ System4  DC.W    $8004,14       ;TYPE Byte⓪)ASC     'BYTE'⓪)DC.B    $FE,$FF⓪)DC.W    $8526⓪)DC.L    1⓪ System5  DC.W    $8005,12       ;Procedure ADR⓪)ASC     'ADR'⓪)DC.B    $FF⓪)DC.W    $8024,101,6⓪ System6  DC.W    $8006,12       ;Parameter ADR (anyThing): Address⓪)DC.B    $FE,$FF⓪)DC.W    $8025,0,2,0⓪ System7  DC.W    $8007,14       ;Procedure TSIZE⓪)ASC     'TSIZE'⓪)DC.B    $FF⓪)DC.W    $8024,103,8⓪ System8  DC.W    $8008,12       ;Parameter TSIZE (anyThing): LongCard⓪)DC.B    $FE,$FF⓪)DC.W    $8025,0,10,0⓪ System9  DC.W    $8009,14       ;Procedure CAST⓪)ASC     'CAST'⓪)DC.B    $FE,$FF⓪)DC.W    $8024,104,0    ;keine Parameter/Result-Beschreibung!⓪ System10 DC.W    $000A,10       ;anonyme Beschreibung fuer LongCard⓪)DC.B    $FE,$FF⓪)DC.W    $8516⓪)DC.L    4⓪ System11 DC.W    $800B,20       ;Procedure NEWPROCESS⓪)ASC     'NEWPROCESS'⓪)DC.B    $FE,$FF⓪)DC.W    $8024,120,16   ;Parameter: ^^PROC⓪ System12 DC.W    $800C,18       ;Procedure TRANSFER⓪)ASC     'TRANSFER'⓪)DC.B    $FE,$FF⓪)DC.W    $8024,121,14   ;Parameter: ^^Address fuer Prozess-Angabe⓪ System13 DC.W    $800D,20       ;Procedure IOTRANSFER⓪)ASC     'IOTRANSFER'⓪)DC.B    $FE,$FF⓪)DC.W    $8024,122,14   ;Parameter: ^^Address fuer Vektor-Angabe⓪ System14 DC.W    $800E,12       ;Parameter NEWPROCESS (...ADDRESS...)⓪)DC.B    $FE,$FF        ;gleichz. TRANSFER, IOTRANSFER, IOCALL (ADDRESS)⓪)DC.W    $8025,2,0,0⓪ System15 DC.W    $000F,14       ;anonyme Beschreibung fuer TYPE Proc⓪)DC.B    $FE,$FF⓪)DC.W    $8413⓪)DC.L    4⓪)DC.W    0,0⓪ System16 DC.W    $8010,12       ;Parameter NEWPROCESS (PROC ...)⓪)DC.B    $FE,$FF⓪)DC.W    $8025,15,0,14⓪ System17 DC.W    $8011,16       ;Procedure LISTEN⓪)ASC     'LISTEN'⓪)DC.B    $FE,$FF⓪)DC.W    $8024,123,0    ;keine Parameter⓪ System18 DC.W    $8012,16       ;Procedure IOCALL⓪)ASC     'IOCALL'⓪)DC.B    $FE,$FF⓪)DC.W    $8024,124,14   ;Parameter: address⓪ System19 DC.W    $8013,12       ;TYPE LOC⓪)ASC     'LOC'⓪)DC.B    $FF⓪)DC.W    $8526          ;ItemNo: 38, wie bei BYTE⓪)DC.L    1⓪ System20 DC.W    $8014,14       ;Procedure CADR⓪)ASC     'CADR'⓪)DC.B    $FE,$FF⓪)DC.W    $8024,105,6⓪ System21 DC.W    $8015,14       ;Procedure DEREF⓪)ASC     'DEREF'⓪)DC.B    $FF⓪)DC.W    $8024,106,0    ;keine Parameter!!!???⓪ System22 DC.W    $8016,28       ;CONST CompilerVersion⓪)ASC     'CompilerVersion'⓪)DC.B    $FF⓪)DC.W    $8012,24,2⓪)DC.L    CompilerVersion⓪ System23 DC.W    $8017,32       ;CONST CompilerSubVersion⓪)ASC     'CompilerSubVersion'⓪)DC.B    $FE,$FF⓪)DC.W    $8012,24,2⓪)DC.L    CompilerSubVersion⓪ System24 DC.W    $0018,10       ;anonyme Beschreibung fuer ShortBothTyp⓪)DC.B    $FE,$FF⓪)DC.W    $8523⓪)DC.L    2⓪ System25 DC.W    $8019,16       ;TYPE BITNUM⓪)ASC     'BITNUM'⓪)DC.B    $FE,$FF⓪)DC.W    $8529          ;ItemNo: 41⓪)DC.L    2⓪ System26 DC.W    $801A,14       ;Procedure SHIFT⓪)ASC     'SHIFT'⓪)DC.B    $FF⓪)DC.W    $8024,107,0    ;keine Parameter!!!???⓪ System27 DC.W    $801B,16       ;Procedure ROTATE⓪)ASC     'ROTATE'⓪)DC.B    $FE,$FF⓪)DC.W    $8024,108,0    ;keine Parameter!!!???⓪ System28 DC.W    $801C,18       ;ASSEMBLER-Identifier⓪)ASC     'ASSEMBLER'⓪)DC.B    $FF⓪)DC.W    $8024,125,0⓪ System29 DC.W    $801D,16       ;Function/Procedure CALLSYS⓪)ASC     'CALLSYS'⓪)DC.B    $FF⓪)DC.W    $8024,126,35   ;1. Parameter: CARDINAL⓪ System30 DC.W    $801E,16       ;Function/Procedure CALLEXT⓪)ASC     'CALLEXT'⓪)DC.B    $FF⓪)DC.W    $8024,127,36   ;1. Parameter: ADDRESS⓪ System31 DC.W    $801F,14       ;Procedure CODE⓪)ASC     'CODE'⓪)DC.B    $FE,$FF⓪)DC.W    $8024,128,0    ;keine Parameter⓪ System32 DC.W    $8020,14       ;Procedure LOAD⓪)ASC     'LOAD'⓪)DC.B    $FE,$FF⓪)DC.W    $8024,129,0    ;keine Parameter⓪ System33 DC.W    $8021,14       ;Procedure STORE⓪)ASC     'STORE'⓪)DC.B    $FF⓪)DC.W    $8024,130,0    ;keine Parameter⓪ Pseudo34 DC.W    $8022,20       ;Subrange [0..15] f. CALLSYS-TRAP-Nr.⓪)DC.B    $FE,$FF⓪)DC.W    $850B⓪)DC.L    2,0,15         ;Size=2, Low=0, Hi=15⓪)DC.W    24             ;Base Type: BothTyp⓪ System35 DC.W    $8023,12       ;Parameter CALLSYS ([0..15]...): LONGWORD⓪)DC.B    $FE,$FF⓪)DC.W    $8025,34,3,0⓪ System36 DC.W    $8024,12       ;Parameter CALLEXT (ADDRESS...): LONGWORD⓪)DC.B    $FE,$FF⓪)DC.W    $8025,2,3,0⓪ (*$? BITSETfromSYSTEM:⓪ System37 DC.W    $8025,20       ;Subrange BITNUM[0..15] f. BITSET⓪)DC.B    $FE,$FF⓪)DC.W    $850B⓪)DC.L    2,0,15         ;Size=2, Low=0, Hi=15⓪)DC.W    25             ;Base Type: BITNUM⓪ System38 DC.W    $8026,18       ;TYPE BitSet⓪)ASC     'BITSET'⓪)DC.B    $FE,$FF⓪)DC.W    $842D⓪)DC.L    2⓪)DC.W    37⓪ *)⓪ (*$? NOT BITSETfromSYSTEM:⓪ System37 DC.W    $8025,6        ;nur dummy⓪)DC.B    $FE,$FF⓪)DC.W    $803F⓪ System38 DC.W    $8026,6        ;nur dummy⓪)DC.B    $FE,$FF⓪)DC.W    $803F⓪ *)⓪)DC.W    0⓪ END⓪ END SysMod;⓪ ⓪ PROCEDURE SysModEnd; END SysModEnd;⓪ ⓪ (* EOT *)⓪ ə
(* $0000A355$0000985C$00011D46$FFE56852$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$00010848$FFE39FFA$00018B3F$FFE39FFA$0001085C$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$000045B4$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFA$FFE39FFAÇ$00010845T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$FFE30C01$00003736$FFE30C01$0000DC02$0000DC0F$0000DC4D$0000DC60$000108FF$00000038$0000DC50$00010893$00010845$00010A3D$00003718$00003781$000037B2ãÇâ*)